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INTRODUCTION 


JAYCOR  is  pleased  to  submit  this  final  report  summariz¬ 
ing  the  tasks  performed  by  JAYCOR  at  the  Navy  Center  for 
Applied  Research  in  Artificial  Intelligence  (NCARAI)  of  the 
Naval  Research  Laboratory, under  Contract  #N00014-85-C-2552 . 

-  j 

’This  report  gives  an  overview  of  the  work  performed  to  meet 
the  tasks,  location  on  NCARAI  computers  where  the  software 
is  stored,  documentation  of  the  software,  and  pertinent 
information  on  any  problems  encountered  during  the  perfor¬ 
mance  of  the  tasks. 


The  report  is  organized  on  a  task  by  task  basis,  each 
task  briefly  explained  and  the  work  summarized.  Any  software 
produced,  obtained,  or  otherwise  installed  to  satisfy  task 
requirements  is  included  in  source  form  in  Appendix.  In 
addition  to  this  summary  final  report,  the  reader  is 
referred  to  the  monthly  reports  submitted  over  the  entire 


period  of  the  contract  to  more  thoroughly  document  the  _  work 
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2.  TASKS  AND  WORK  PERFORMED 


In  addition  to  the  maintenance  of  the  UNIX  system  on 
the  VAX  computers,  JAYCOR  implemented  functions  and  programs 
for  a  number  of  peripherals.  Background  information  on 
these  peripherals  and  key  points  of  interest  about  the 
software  is  summarized  below.  If  the  software  was  modified 
from  previously  existing  software  rather  than  completely 


im 


rewritten  by  JAYCOR  personnel,  pointers  to  the  original 
source  are  also  given.  Location  of  online  source  code  and 
documentation  is  noted. 


2.1.  3/4"  VIDEO  TAPE  PLAYER  (VAX  and  LMI) 

During  the  previous  system  programmer  contract  period, 
the  AI  Center  took  delivery  on  a  programmable  3/4"  video 
tape  player.  This  player  has  much  the  same  functionality  as 
the  1/2"  player  which  JAYCOR  programmed  under  that  contract. 
This  software  was  thus  usable  in  very  slightly  modified  form 
with  the  larger  tape  size. 

To  use  and  program  the  player  from  the  VAX,  the  user 
connects  it  to  the  TERABIT  computer  interface  according  to 
the  TERABIT  manual.  To  use  from  the  LMI  LAMBDA  computer, 
the  user  connects  the  player  to  the  TERABIT  interface,  then 
connects  the  TERABIT  interface  to  the  LAMBDA  serial  port 
labeled  "SDU-Serial-B" .  One  then  runs  the  software  written 
by  JAYCOR  personnel  under  the  LISP  environment  as  documented 
in  the  manual  in  the  Appendix.  Each  function  can  be  indivi¬ 
dually  invoked  or  can  be  combined  into  a  complex  program  of 
function  calls  as  suits  the  user. 

All  software  for  this  task  is  contained  in  the  VAX- 
11/780  directory  "/aic2/smith/contracts/sys2"  under 
appropriate  subdirectories.  Additional  copies  of  the  LMI- 
specific  software  are  also  available  on  the  LMI  computer. 


2.2.  1/2"  VIDEO  TAPE  AND  DISK  PLAYERS  (LMI) 

The  tape  and  disk  player  software  programmed  under  the 
previous  contract  for  the  VAX  was  transported  to  the  LMI 
computer  both  to  allow  continuity  of  interface  and  to 
prevent  duplication  of  previous  programming  effort.  During 
the  transportation  modifications  to  the  FRANZ  LISP  code  were 
made  to  make  it  COMMON  LISP  compatible.  Full  functionality 
was  maintained  during  this  transfer. 

The  user  interface  is  quite  similar  for  both  of  these 
peripherals  to  that  of  the  3/4”  tape  player,  hence  users  are 
not  presented  with  a  confusing  change  in  command  structure. 
The  Appendix  contains  copies  of  the  manuals  with  small  exam¬ 
ples  of  usage  demonstrating  this  similarity. 

The  software  and  documentation  for  these  peripherals  is 
located  in  the  VAX- 11/7 80  directory 
M/aic2/smith/contracts/sys2"  under  appropriate  subdirec¬ 
tories.  Where  duplicate  copies  of  software  were  possible, 
hard  file  links  have  been  used  instead. 

2.3.  RACAL-VADIC  MODEM  DRIVER  (LMI) 

The  LMI  LAMBDA  computers  come  with  a  version  of  the 
public  domain  KERMIT  program.  This  program  uses  whatever 
modem  (or  simple  connection)  is  attached  to  the  "SDU- 
Serial-B"  rs232  port.  For  this  task,  JAYCOR  personnel  con¬ 
nected  the  Racal-Vadic  modem  to  the  serial  port,  enabled  the 
port  by  running  the  KERMIT  program,  and  tested  out  the 


functionality  of  the  modem  through  connections  from  the  LMI 
to  the  VAX  computers.  The  KERMIT  program  was  successfully 
tested  by  transferring  files  from  the  LMI  to  the  main  VAX 
computer.  All  Racal-Vadic  internal  operations  were  accessi¬ 
ble  through  the  KERMIT  software  interface. 

To  use  the  KERMIT  program  while  logged  into  the  LMI 
computer,  type  in  <SYSTEM>K,  thus  starting  the  KERMIT  pro¬ 
gram.  Then,  using  the  mouse  in  the  standard  manner 
(explained  in  LMI  documentation),  "click"  on  the  "Connect" 
menu  selection.  One  can  then  use  the  Racal-Vadic  modem  pro¬ 
gramming  commands  as  if  connected  through  a  terminal. 

The  KERMIT  software  (enabled,  tested,  and  verified,  but 
NOT  supplied  by  JAYCOR)  is  located  on  the  LAMBDA  computer 
under  the  system  source  directory.  Due  to  its  large  size  it 
is  not  duplicated  in  this  summary  report. 

2.4.  LA50  PRINTER  DRIVER  (LMI) 

Two  versions  of  printer  drivers  were  written  by  JAYCOR 
personnel  for  this  task.  Both  versions  are  capable  of 
printing  rectangular  screen  areas  onto  an  LA50  printer  con¬ 
nected  to  the  "SDU-Serial-B"  rs232  port.  The  areas  give  a 
somewhat  accurate  graphic  rendition  of  the  actual  screen 
display,  however  the  aspect  ratio  is,  as  expected,  not  1:1. 

One  major  problem  with  the  use  of  the  serial  port  and 
the  LA50  printer  was  uncovered  during  the  implementation  of 
this  software,  namely  the  lack  of  adequate  flow  control 


during  the  printing  process.  For  some  larger  sized  rectangu¬ 
lar  regions,  the  LA50  can  not  keep  up  with  the  LAMBDA'S 
stream  of  data,  hence  attempts  to  use  XON/XOFF  flow  control 


to  synchronize.  Unfortunately,  the  LAMBDA'S  serial  port 
software  does  not  use  flow  control  in  its  current  configura¬ 
tion  so  some  data  can  be  lost,  resulting  in  both  skew  of  and 
superfluous  patterns  in  the  output  image. 

The  utility  of  the  LA50-based  printing  has  been  super- 
ceded  by  the  much  higher  resolution  printing  available  with 
the  Ethernet-connected  IMAGEN  laser  printer.  This  printer 
produces  much  finer  images  much  more  quickly  over  the  high 
speed  network  link.  All  software  is  kept  on  the  LAMBDA  com¬ 
puter  . 

2.5.  RESTRICTED  SHELL 

As  JAYCOR  noted  in  its  proposal  for  the  subject  con¬ 
tract,  this  task  is  met  by  having  a  "shell"  field  in  the 
password  entry  for  a  user  which  will  only  invoke  a  specific 
program,  logging  off  on  exit.  Due  to  the  nature  of  the 
library  system  installed  by  the  NCARAI,  this  method  of 
access  restriction  will  not  be  necessary  at  this  writing, 
instead  a  unique  login  ID  and  password  are  used  with  NRL's 
library  system  (explained  in  the  following  sections  dealing 
with  library  tasks). 

2.6.  RAMTEK  SOFTWARE 

Under  the  initial  system  programmer  contract  awarded  to 


JAYCOR,  graphics  functions  were  implemented  which  allowed 
users  to  interface  their  C  programs  to  the  Ramtek  devices  on 
both  the  VAX-11/780  and  VAX-11/750  (ATE  machine) .  This 
software  provided  line  and  rectangular  region  graphics  as 
well  as  text  in  colors  selected  by  the  user.  These  functions 
have  been  extended  and  an  interface  to  the  FRANZ  LISP 
environment  has  been  implemented  to  meet  the  requirements  of 
this  task.  In  addition,  certain  image  processing  functions 
have  been  implemented  and  a  sample  set  of  images  obtained 
for  testing  purposes. 

All  software  for  this  task  is  stored  in  the  VAX-11/780 
directory  "/aic2/smith/contracts/sys2"  under  an  appropriate 
subdirectory.  The  functions  typically  are  all  self  document¬ 
ing  due  to  their  simple  usage,  but  other  documentation  is 
also  in  the  same  location. 

2.7.  LIBRARY  DATABASE 

The  library  database  was  tested  thoroughly  during  the 
initial  period  of  this  contract.  After  this  testing  and  com¬ 
munication  with  other  libraries  in  the  area  (Library  of 
Congress,  NRL  main  library),  it  was  decided  to  obtain  the 
standardized  OCLC/DIALOG/LS2000  accessing  permissions,  thus 
maintaining  compatibility  with  libraries  throughout  the 
country.  An  OCLC  terminal  (actually  an  IBM  PC  with  appropri¬ 
ate  hardware  and  software  enhancements)  was  received  and 
installed.  It  has  proven  to  be  a  valuable  asset  to  the 
library.  When  the  main  NRL  library  LS2000  system  comes 


fully  online,  the  NCARAI  library  will  be  able  to  access  and 
use  the  main  NRL  database  for  such  things  as  verifying  the 
availability  of  references,  checking  out  of  references,  and 
doing  subject/author/keyword  searches.  Arrangements  have 
been  made  with  the  main  library  to  obtain  "zebra  codes"  for 
the  current  references  in  the  NCARAI  library.  These  will  be 
attached  to  the  spines  of  the  books  and  allow  the  computer¬ 
ized  checking  out  of  references  to  be  performed. 


2.8.  LIBRARY  ORGANIZATION 


The  library  has  undergone  considerable  rearrangement 
since  contract  award.  References  have  been  organized  to 
more  closely  follow  standard  library  practice,  circulation 
for  periodicals  has  been  totally  redone  to  provide  more 
timely  circulation,  and  the  physical  arrangement  of  the 
library  has  been  changed  to  allow  easier  access  to  the 
stacks . 


In  addition  to  the  above,  the  design  of  an  expanded 
library  has  been  submitted  to  the  COTR.  This  new  library 
takes  into  account  the  tremendous  influx  of  new  references 
and  the  expanding  space  necessary  to  hold  them.  Using  the 
current  "community"  room  in  the  AI  Center,  the  library  will 
be  able  to  handle  acquisitions  at  the  current  rate  for  a 
number  of  years.  At  the  same  time,  the  study  atmosphere  will 
be  improved  significantly  through  the  presence  of  natural 
light  from  the  large  window  area  and  the  ability  to  use 
study  carrels. 


2.9.  DOCUMENT  ORGANIZATION 


A  large  number  of  documents  have  been  ordered  and 
received  from  DTIC.  These  documents  comprise  the  collection 
of  works  which  in  some  manner  reference  AI.  The  documents 
were  obtained  in  both  hardcopy  and  Microfiche  form.  The 
current  plan  for  cataloging  these  documents  is  to  order  the 
DTIC  listing  from  which  they  were  ordered.  This  would  be  in 
addition  to  the  ordered  storage  of  both  the  fiche  and  the 
hardcopy  (see  the  Inventory  section  below). 

2.10.  POINT  OF  CONTACT 

Throughout  the  period  of  the  contract  the  JAYCOR 
librarian  has  interacted  considerably  with  the  user  commun¬ 
ity.  This  interaction  has  covered  the  range  of  duties  from 
simple  reference  lookup  to  the  arrangement  of  interlibrary 
loans.  Professional  relationships  have  been  developed  with 
the  NRL  library  as  well  as  with  the  Library  of  Congress. 
These  relationships  are  ongoing . 

2.11.  INVENTORY  AND  REQUIREMENTS  ANALYSIS 

The  JAYCOR  librarian  has  been  closely  involved  with  the 
COTR  in  performing  a  requirements  analysis  for  the  library. 
From  this  analysis  the  needs  of  the  library  were  discovered 
to  exceed  current  library  capabilities.  This  led  to  the 
planning  of  the  new  expanded  library  space  using  the  NCARAI 
community  room.  This  room  will  be  much  more  conducive  to 
study  and  research. 


Another  product  of  the  library  analysis  was  the 
acquisition  of  a  Microfiche  hardcopy  printer.  This  machine 
has  been  very  well  received.  Using  standard  fiche,  the  user 
can  view  a  document  and,  if  desired,  make  a  hardcopy  version 
at  will.  Through  the  use  of  fiche  for  much  of  the  documents 
received  by  the  Center,  considerable  space  will  be  saved. 


APPENDIX 


This  Appendix  contains  copies  of  the  source  code  of  all 
software  used  to  satisfy  the  requirements  of  the  tasks  of 
the  Statement  of  Work.  This  software  was  either  written, 
modified,  or  acquired  by  JAYCOR  as  noted. 
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Usage 

The  video  tape  player  can  be  operated  from  lisp.  The  routines  are  written  in 
C.  These  routines  should  be  loaded  in  to  lisp  before  using  them.  To  use  them  do 
the  following: 

(1)  switch  on  the  Terabit  (VM-820). 

(2)  switch  on  the  video  player. 

(3)  if  a  SONY  tape  player  is  used,  set  remote  select  switch  on  the  back  side  of 
the  tapeplayer  to  300  position. 

On  VAX 

(load  ’tapefns) 

(vp-open) 

—  whatever  — 

(vp-close) 

On  LMI 

(load  ’tapefnslm) 

(with-open-file  (‘video*  "sdu:serial-b:") 

(send  ‘video*  ’:set-baud-rate  9600) 

—  whatever  — 

) 

Some  times  this  won’t  work  due  to  the  serial-port  being  opened  by  someone 
and  forgot  to  close.  In  that  case  use  the  following: 

(with-open-file  (‘video*  (steal-port-b) 

(send  ‘video*  ’:set-baud-rate  9600) 

—  whatever  —  ) 

On  Symbolics 

(load  ’discfnslm) 

(with-open-stream  (‘video*  (si:make-serial-stream  ':unit  2 

kbaud  9600  kcheck-over-run-errors  t  kascii-characters  t 

kforce-output  t)) 

- whatever - 1 


Commands 

Following  is  a  description  of  each  of  the  functions  that  can  be  called  from 
lisp.  All  the  commands  return  an  integer  code.  A  value  of  0  indicates  success.  For 
other  values,  an  error  message  is  printed  and  an  integer  between  1  and  9  is 
returned. 

Name:  vp-retid 

Arguments:  none 

Description:  vp-retid  is  always  called  (internally)  after  the  execution  of  each 

command.  This  function  returns  an  integer  indicating  the  status. 
A  value  of  0  indicates  success.  For  any  value  other  than  0.  an 
appropriate  error  message  is  printed  and  an  interger  is  returned. 

Name:  vp-open 

Arguments:  none 

Description:  Video  player  open  (only  on  VAX). 

Enables  device  communication. 

Name:  vp-close 

Arguments:  none 

Description:  Video  player  close  (only  on  VAX). 

Disables  device  communication. 

Name:  vp-home 

Arguments:  none 

Description:  Home. 

To  place  VM-820  in  a  known  state.  This  should  be  the  first  com¬ 
mand  sent  to  VM-820. 

Name:  vp-initialize 

Arguments:  none 

Description :  Initialize. 

Positions  the  tape  at  the  first  valid  frame. 

Audio  and  video  are  turned  off  during  this  command. 

Name:  vp-quit 

Arguments:  none 

Description:  Quit 

Terminates  active  command. 

Name:  vp-play-forward 

Arguments:  nl  n2 

Description:  Play  forward. 

Plays  the  tape  from  nl  to  n2. 
both  nl  and  n2  should  be  integers. 
n2  =  0  =  >  plays  till  the  end. (default) 
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Name: 

Arguments: 

Description: 

Name: 

Arguments: 

Description: 

Name: 

Arguments: 

Description: 


Name: 
Arguments: 
Description : 

Name: 

.4  rguments : 
Description: 

Name: 

Arguments: 

Description: 

Name: 

Arguments: 

Description: 

Name: 

A  rguments: 
Description : 


nl  <  0  =  >  plays  from  the  beginning  frame, 
nl  =  0  =  >  plays  from  the  current  frame. (default) 

vp-fast- forward 

none 

Fast  forward. 

Fast  forwards  toward  the  end  of  the  tape. 

vp-rewind 

none 

Rewind. 

Rewinds  toward  the  beginning  of  the  tape. 

vp-go-  to-  frame 

nl  n2 

Go  to  a  frame  number. 

Advances  to  the  frame  number  nl. (default:  beginning) 
n2  specifies  the  video  end  condition. 
n2  =  0  =>  video  stops  after  reaching  nl. (default) 
n2  =  1  =>  video  plays  after  reaching  nl. 

vp-single-frame 

none 

Single  frame. 

Plays  forward  a  single  frame. 

vp-frame-number 

none 

Current  frame  number. 

Returns  the  current  frame  number. 

vp-hold-enable 

none 

Hold  enable. 

Pauses  the  tape  at  the  current  location. 

vp-hold-disable 

none 

Hold  disable. 

Unpauses  the  tape. 

vp- last-command 

none 

Last  command. 

Returns  the  last  active  command. 

0  -  no  active  command 


I 

1 

» 


( 


I 

I 

» 


I 

f 

» 


Name: 

Arguments: 

Description: 


Name: 

Arguments: 


Description: 


Name: 

Arguments: 

Description: 


1  -  vd-FF  (fast  forward) 

2  -  vd-G  (Go  to  frame) 

3  -  vd-R  (reject) 

4  -  vd-I  (initialize) 

5  -  vd-PF  (play  forward) 

6  -  vd-HE  (hold  enable) 

7  -  vd-HE  (hold  disable) 

8  -  vd-SF  (single  frame) 

9  -  vd-FR  (rewind). 

vp- last-command-status 

none 

Last  command  status. 

Returns  the  status  of  the  last  command. 

A  value  of  0  indicates  completion. 

vp-environment-read 

none 

(lispmc  can  take  an  optional  arg:  oneof  (video  audiol  audio2 
videoend  continuous) 

Environment  read. 

Returns  the  present  environment  setting  as  an  integer. 

Returned  integer  positions  =  87654321. 
position  description  (1-on  :  O-off) 

8  video 

7  audio  ch.l 

6  audio  ch.2 

5  video  end  condition. 

4  Continuous  F rames. 

3,2,1  —  always  Os  (not  used), 

on  lispmc 

if  noarg,  returns  a  list  (videoststus  chlst’  ch2sta’  videoendst’ 
contsta') 

if  arg  returns  arg’s  status  as  0/1 . 

vp-getc 

argl 

Get  the  current  status  of  argl. 

Returns  the  present  environment  setting  of  argl  as  t /nil  indicat¬ 
ing  on/off. 

Argl  should  be  one  of  the  following: 

video,  audiol,  audio2,  videoend.  continuous, 
only  on  VAX.  For  lispmc,  see  vp-enmronment-read. 
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Name: 

vp-environment- write 

Arguments: 

nl  n2  n3  n4  n5 

Description: 

Environment  write. 

To  write  the  environment  settings, 
nl  -  video  (1-on,  O-off) 
n2  -  audio  ch.l  (1-on,  O-off) 
n3  -  audio  ch.2  (1-on,  O-off) 
n4  -  video  end  cond.  (1-on,  O-off) 
n5  -  Continuous  frame.  (1-on,  O-off) 

Name: 

vp-setc 

Arguments: 

argl  arg2 

Description: 

Set  the  condition  of  argl  to  arg2. 

Argl  should  be  one  of  the  following: 

video,  audiol,  audio2,  videoend,  continuous. 

Arg2  should  be  on/off/ 1/0. 

Returns  0. 

Name: 

vp- mode-computer 

Arguments: 

none 

Description: 

Mode  computer. 

To  set  the  VM-820  to  computer  mode. 

This  is  the  initial  mode  after  the  power  on  of  the  VM-820 
reset. 

Name: 

vp-  mode-  terminal 

Arguments: 

none 

Description: 

Mode  terminal. 

To  set  the  VM-820  to  terminal  mode. 

Name: 

vp-sendnum 

Arguments: 

nl 

Description: 

Sends  a  number  (integer)  nl. 
vp-sendnum  is  used  to  send  an  integer. 

Name: 

vp-eject-tape 

Arguments: 

none 

Description: 

Eject  tape. 

Unloads  the  tape. 

Name: 

vp-putchars 

Arguments: 

nl 

Description: 

send  the  chars  obtained  by  evaluating  nl  (VAX), 
lispmc:  nl  should  be  list  and  sends  all  the  chars  in  nl. 

Used  to  explicitly  send  chars  corresponding  to  commands. 

-  6  - 
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Note: 

Name: 

Arguments: 

Description: 

Note: 


Example:  (vp-putchars  ’FF@)  to  fast  forward  the  tape. 
Carriage  return  is  denoted  by  @  character. 

vp-getchars 

nl 

Reads  nl  chars  from  the  video  line, 
nl  =  0  implies  read  till  end  of  line. 

Example:  (vp-getchars  4)  to  read  4  chars  from  the  video  line. 
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Theaa  function*  ara  used  to  load  in  the  C  coda  and  bind  LISP 
function  qim«  to  the  particular  C  routiota.  Run  one*  at  startup  tiM 


(cfanl  ‘ /usr/ local/ lib/Tldeo/Tplay . o  ' _T_opeo  ' Tp-open  " Integer- function- ) 
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( gataddraaa 
( gataddraaa 
( gataddraaa 
( gataddraaa 
I ( gataddraaa 
( gataddraaa 
( gataddraaa 
( gataddraaa 
( gataddraaa 
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' _*_cloaa  • Tp-cloaa  " intagar- function- ) 

* ~SatTor«  'vp-aat  " integer- function “ ) 

' Z*»tTarm  ’Tp-rasat  "lntagar-function") 

‘ ~»_ratld  1 Tp-ratid  - tntagar- function- ) 

1  *p-saodnua  “lntagar-function") 

_*ZrF  ' VP~ faat- forward  - intagar- function"  ) 

' ZTIF*  ▼p-rawind  “ tntagar- function- ) 

' ZwZa  ' ▼p-I-go-to-fraaa  - intagar- function" ) 

' _»ZaD  *P-hold-dlsabla  - intagar- function" ) 

• ‘ »p- hoid-anabla  - Intagar- function- ) 

'ZwZl  ’ *p“ initialize  - intagar- function" ) 

‘Z*IpF  'rp-i-piay- forward  - intagar- function " ) 

_TIR  ' ▼p-ajoct- tapa  " Intagar- function" j 
1 I*Isr  ' Tp- alngla- f raaa  - Intagar- function" ) 

■_*_H  Tp-boaa  - Intagar- function" j 
1 Z*Zer  Tp-ao»lronaant-raad  " In tagar- function" ) 

1 I*I*_fetc  ' *p.*_gatc  " intagar- function" ) 

* _tZe«  vp-aovlronaant-urlta  " Intagar- function" ) 
•_*Z*..s*tc  '  *p_*_satc  “  intagar- function  ) 

•_tZl~  Tp- l* it- comm* ad  " intagar- function" ) 

1 _*ZMC  ▼p-aoda-coaputar  " intagar- function" ) 

'  _»ZmT  vp-aoda- taramal  "lntagar-function- ) 

•  vp- f  raaa- nuabax  "  intagar- function  * ) 

' »p-quit  "lntagar-function") 

’ ZVI-  »p- laat-coaaand- status  “lntagar-function") 
'ZTIptcba  Tp_pcha  "lntagar-function") 

' _T_gtcbs  ▼pZgeba  " intagar- function" ) 

ZTIflu*l>  ■▼p-flush  "  lntagar-function"  ) 


(dafun  Bapnaaa(xl) 
(CODd  (  ( aqua  1 
( ( aqua  1 
( ( aqual 
( ( aqual 
< < aqual 
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'  - O  Q  1 1 Q  UO 
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to  rp-aatc/gatc 


"  )  0)  )  ) 


(dafun  vp-gatc(xi) 

(-  -i  (▼P_»_gatc  ( aapoaaa  xl)))) 


(dafun  »p-aatc(xi  x2) 

( rp_T_aatc  (aapoaaa  xl >  (on-off  x2))) 


(dafun  on-off ( at ) 

(cond  ((aqual  at  on)  1) 

<  t  *>)  )  ) 

(dafun  ap-qo- to- Craaa  faxpr<l) 

(cond  ((null  1)  <  Tp- I - go- 1 o- f  r  aaa  0  0)) 

((-  ( langth  L)  l)  (  Tp- 1 -go- to- f r sea  (car  1) 
_ (t  ( Tp-i-go-to-fraaa  (car  1)  (cadr  1))))) 


0)  ) 


I 


(dafun  Tp- pi ay- forward  faxpr(l) 

(cond  ((null  1)  ( Tp- I -play- forward  -l  0)) 

{(•  (langth  1)  1)  ( Tp- I -go-to- fraaa  (car  l)  0)) 
(t  (^p- I -go-to- fraaa  (car  1)  (cadr  1))))) 

I  (dafun  rp-putchars  (cchara) 

(Tp_pch*  (langth  (axplodan  cchara)) 

(apply  • Tactorl-byta  < a axplodan  cchara)))) 


(dafun  Tp-qatchars  (oua)  _  I 

( lat  ((chars  ( naw-Tactorl-byta  50  ! 

(ana) 

(tl  Oil 

(Tp^gcha  nua  chars) 

(whtla  (and  (<  tl  50)  (not  (-  (vrafl-byta  chara  tl)  94))) 

( aatq  ana  (cona  (vraft-byta  chara  tl )  ana) 
tl  (  ♦  tl  L) ) ) 

(ravarsa  (apply  ' appand 

(id  '  ( laabda(X) 

( cond  < ( -  x  94 )  ill > 

<t  <  1  lat  ( aakoaa  (Hat  x))))))))))) 


(dafua  vp-halpf ) 
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Loadad  In  by  tha  lisp  calls  in  * tapaf as . 1“ ,  thasa  ara  tha  actual 
routine#  that  interface  to  tthe  tap*  players.  All  LISP  functions 
call  these  to  do  their  work.  Coaptle  with: 

cc  -O  -c  ▼play . c 


j* include  <sgtty  h> 

| Idef loe  RBTUIM  \01S* 

(static  lot  video, 

(static  char  buff(2S|, 

(/•  to  open  tha  video  playar  •/ 

j v_open( ) 


lot  SatTar»( ) . 

lf( (video  •  opeo( “/dev/ ttyiO" ,  2)) 
S*tTera( ) , 
r*turn(  0 )  . 


/ •  to  closa  tha  video  playar 
v_clo*a< ) 


0)  raturn  (-1). 


lot  RatTar»( ) . 
RstTer«< ) . 
closa( vidao ) . 
raturai 0 ) , 


struct  sqttyb  oldaodai.atwiodai. 

•  to  sat  tha  line  to  rtwaoda  •/ 

SatTarat ) 

{ 

Loctli »ldao,  TIOCGCTP,  fcoldaodes). 
loctl( »idao,  TIOCGCTP,  uawaodas), 
aavaodai  iq  tUgs  -  RAH , 

□  •vaodas  iqjlaqj  fc-  “ECHO , 
nawiodii  <q_Up«ad  »  09600. 
aavaodai . tgospaad  -  B9600. 
iocti< video,  TIOCSETN.  koevaodas), 


*  to  sat  tha  lioa  back  to  ooraal  sod* 
RttTarai ) 


ioctl(vtdao,  TIOCSETN,  fcoldaodas). 


/•  to  get  tha  return  Id  aod  print  tha  arr  aaq,  if  any  •/ 
lnt  v  ratid( ) 

< 

Lnt  c_to_t< ) « 
raad( vidao , buf  t , i ) . 


Vfi 

I 


m 


switch  ( buf f ( l I ) ( 

casa 

casa  ' 0 ' 

raturn ( 0 ) - 

casa  ' l ' 

prlatf ( " I  Hagai  Coasand  for  this  sachlna:  kc  kc  kc\n“ , 
buff (Oj , buf f ( 1 | .buff [21 ), 
raturnf 1 ) , 

casa  ' 2 ' 

prlatf ("Bad  coaaaod  (oraat  kc  kc  kc  \o“ , 
buff (0) .buff (II .buff  (  2|  ). 
ra turn (  2 )  . 

casa  '  3 ' 

prlatf ("Bad  option  foraat:  %c  kc  %c  \o"  , 
buff (0| , buf  f ( 1 1 , buf  f ( 2  I  ) , 
raturn ( 3 )  . 

casa  ' « ' 

printf  (  "List  activa  coaaaod  is  still  active:  kc  %c  kc  v.n" 
buff (0 | .buff (If .buff (2(| . 
raturo<  4 ) , 

casa  ‘ 5 • 

printf ( "Coaaaod  fallad:  %c  kc  kc  \n“ , 
buf f (01 .buffi 1 1 .buf f  (  2  |  ) , 
return ( 5  > , 

casa  ' 9 ’ 

printf ("Bad  aachloa  coda'  kc  »c  kc  > o" , 
buff (0) .buff ( L J .buff (2|  j. 
raturn ( •  )  . 

c  asa  k  • 

buffi  0  )  -  buff( 2  |  . 
raid( vidao , buf  f ♦ L  ,  3  )  , 
raturo  (c_to_l(buff.®M, 

daf suit 

pr intf < " raturoinq  undafinad  coda  kc\ n" , buf f I l | ) , 
returo<  ? ) , 


••  to  cbssqa  chsr  to  iotaqar  *■ 

lot  r_to_i( s, 1 j 
chsr  • I | 7 
i  nt  i . 

( 

tot  i  •  ■). 

lot  n  •  0, 

whila  (  a  (  i  |  >•  O'  as  »(i|  -  9*  fcfc  i  <  1){ 
a  •  L0*  n  *  s(t|  -  0*. 


/ •  to  a and  a  auabar 
Lat  t  lasdaua(x) 
lot  • * . 


tot  bl  -  14. 

lnt  y, 

char  tbufffisi. 


•»« 


A 


while  (y  >  0  u  bt  >  - L )  { 

tbuff ( b  1 — )  -  y  %  10  *  'O’ 
Y  /-  10, 

I 

wrlte<vldeo,  tbuf f+bi+l ,  14-bi), 


fast  forward 

t  *_rr i ) 


Lot  v  retid( ) , 
buff l o i  -  *  r* , 
buff( II  “  ‘ F*  . 

buff  12)  -  RETURN, 
laeekf video , OL, 2 > ,  * 

wrltei video , buff ,  3 ) . 
raturof v_retld< ) ) . 


fast  ravarsa  •/ 

tr_FR(  ) 

Lot  v  r*tid(  ) , 
buff l 0 1  -  r*, 

bufflL)  -  '  R  *  . 

buff ( 2 |  -  RETURN, 
laeek ( video, OL, 2 ) ,  * 
writs ( video, buf f , 3 ) , 
raturo{ v_retid( ) ) . 


to  a  fr&aa  ouabar 
La  fraae  ouabar .  o2  Is  oo 
_G { n 1  ,  a2  ) 

Q 1 .  « a2 , 

Lot  v_retid< ) , 
buff( 0)  *  ' G ' , 
buff  11)  -  •/’, 
buf t ( 2  j  •  e  . 

buff  m  -  {  -n2  >  0)  ■>  1 

buf f  (4  1  - 
buff(5|  -  RETURN, 
laeek < video , OL , 2 ) .  «/ 
wrt te< video , buf  f , 5  ) , 
vssodnun( ol ) , 
wrltei fidao,  buff*5.  1), 
raturof v_retld< ) ) . 


Ls  oo  off  flag 


•O',  /•  play  or  stop  •/ 


I/*  bold  disable 
i  Lot  v_HD( ) 


Lot  v  retld(), 
buf f 10)  -  ■ H' . 
buf f ( 1 ]  -  ‘O', 
buf f ( 2 )  -  RETURN, 
laeek ( video , 0  L , 2 ) ,  * 
wrltei video, buf f . 3 ) . 


raturof v_retid( ) ) . 


/•  bold  enable 
,  Lot  v_HE( ) 


lot  v  retidi ) , 
buff(O)  -  e1, 

buf f [ 1 ]  •  ' E ‘ , 
buff f2)  -  RETURN, 
l  seek ( video , OL , 2 ) ,  * 

wrltei video , buf f , 3) , 
raturof v_retld( ) ) « 


./•  initialize 
I  lot  v_i {  ) 


Lot  v_retld( ) > 
bufflO)  -  I1, 

buff(l)  -  RETURN; 
lseek( video, OL, 2 ) ,  V 
wrlte<  video, buf f , 2 ) , 
return ( v_ret id ( ) ) , 


lay  forward 

1  is  fraae  ouaber  to  start,  o2  Ls  fraae  ouaber  to  eod 
1  <  0  starts  froa  begining,  o2  ■  0  stops  at  the  eod 
1-0  starts  froa  the  current  fraae  */ 
v_pp(nl,  n2) 

•ol,  «n2. 

Lot  ▼  retidi ) . 

bufflO)  -  P  •  , 

buf f 1 1 )  -  •  F‘  , 

buf f (2 )  -  ' 

buff  11)  - 

buff{4)  »  RETURN, 

lseek ( video, OL .  2  ) ,  */ 

wrltei  video,  buf  f ,  2  )  ,■ 

L  f  (  *  ol  —  0)( 

wrltei  video,  buf  f+4 ,1) 
returniv  retidi)), 

) 

If ( *01  <  l)  {  «nl  •  0.) 
wrltei  video ,  buf  f*2  , 1 ) 
v  seodnuai ol ) , 

If  \ *e2  >  * o 1 )  l 

wrlte( video,  buff* 3,  1)> 
r_«aad> ua<  o2  ) . 


write (video,  buff *4,  l), 
return ( v  retidi ) > , 


/•  reject  •/ 
lot  v_R( ) 


tot  v  retld()« 
buff [0  I  -  • R'  . 
buff( l)  -  RETURN , 

I/*  1 seek [video, 0L,2),  •/ 

i  write! video. buff , 2) i 

rttuxn(T  r«tid( ) ) , 

I 

j/*  single  step  forward  a  frame  V 


tot  v  retid! ) , 

I  buff [5)  -  S*. 

buff ( l ]  -  T', 
buff  12 )  *  RETURN, 

!/•  I seek < video, OL, 2 )  ,  •/ 

write! video , buf f , 3 ) . 
r«tuiD(T  rettd( ) ) , 

j  I 

,/•  home  vn  -820  •/ 

:  tot  v_a< ) 

[ 

but f  [01  -  , 

buff[ i J  -  RETURN, 

/*  lseek( video , OL , 2 )  .  •/ 

write! video , buf  f  ,  2 )  , 
read! video , buf f , 1 ) , 
j  tf  (*buff  --  ’ ••)  return! 0), 

pr intf ( “ returning  undefined  coda  %c\n“ , «buf f } , 
return ( 7 ) , 

]  } 

/•  •orirooMot  read  •/ 
tot  v_ER<  ) 

( 

tnt  v  retid( ) / 
buf f 10]  -  • E 1  , 
buf  f  IU  -  '  R'  . 
buf  f ( 2 )  -  RETURN, 

/*  lseek ( video , 0L, 2 ) ,  •/ 

write! video, buf f , 3 ) , 
j  return* v_retid( ) ) , 

;  /  *  7  7  gate  •/ 

] lot  v_v_getc( ol ) 
lot  • at , 

I  ( 

buttlO]  -  ‘E\ 
buf f (I]  -  'R'  , 
buff ( 2 1  »  RETURN, 
i/*  tseek ( video , OL , 2 ) ,  */ 

;  write! video , buf f , 3 ) , 

!  read!  video,  buff  ,3) 

switch  ( buff( 1] ) I 
cu«  '  *  ' 

I  ca«*  ‘O' 


return! 0) , 


prlntf (" I llegal  Coma and  for  this  machine:  4c  %C  4c\n" , 
buff [0) ,buf f [1] , buff [2] ), 
raturn( 1 ) ; 

case  ' 2 ' 

prtntf("B*d  command  format:  %c  4c  %c  \n“  , 
buff [01 ,buff [11 , buff [2 1 j , 
return!  2 ) 

caae  ’ 3 1 

prlntf("Bad  option  format:  4c  4c  %c  \n“ , 
buff [01 , buff (1J ,buff [21 ) , 
return!  3 )  „• 

case  ’ 4 ' 

prlntf ( "Last  active  command  Is  still  active:  4c  4c  4c  \n“, 
buff [01 , buf f  f 1 J , buff [2J ), 
return! 4 ) , 

case  ' 5 ‘ 

prlntf ( "Command  failed:  4c  \c  4c  \n*  , 
buff [0] , buf f(l] , buff (21 ), 
return! 5)  > 

case  1 8 ' 

prlntf! "Bad  machine  code:  %c  »c  %c  \n", 
buff [01 , buf f ( 1 | , buf f ( 2J); 
return! 8 ) , 

case  '8' 

buf  f [ 0 )  •  buf f [ 2 ) , 
read! video , buf f >1 , 8 )  , 

If  coi  <  1  ,  !  -Hi  >  5| 

(prlntf ( ‘ illegal  first  argument  \n“),  return! • nl ); 1 
else  if  (buff[»oll  «•  ‘0‘)  ceturn<-2). 
return!- I j , 


default: 

prlntf  ("  returning  undefined  code  •  4c\n"  ,  buf  f  [  1 J  )  ,• 
return! 7  > , 


/*  environment  write  •/ 
tnt  v_EN(nl,  o2,  o3,  o4 ,  n5) 
tnt  »nl,  *o2,  »n3,  *n4,  »n5. 

I 

tnt  v_retld( ) , 


buf f { 0 

‘  E  ’  , 

buff [1) 

»’  , 

buf f (2? 

buf f ( 3 | 

V  . 

buff [41 

'  I  '  , 

buff [51 

<*nl  — 

0  )  ■»  ■  0  • 

'  1  *  . 

buff [6 | 

'  h '  , 

buff | 7 | 

2  ' 

buff [01 

{ wo2 

0)  »  -0*  : 

’  1  1  . 

buff [81 

C*  , 

buf f f 10) 

-  !  *nl  — 

0)  ■>  ’0' 

■  i* . 

buff [11) 

-  '  E  ‘  * 

buff [121 

-  !  **>4  — 

0)  >  -o* 

•  l  ■ , 

bufff LJ| 

•  'V‘, 

buff (14 ) 

-  ("85  — 

O)  *  O' 

■  l  • , 

buff [15? 

-  RETURN, 

/•  1 seek [vt  deo ,  0  L ,  2  ) ,  •/ 


& 


I 


wrtte( video, buf f , 16 ) 
returot T_retld( ) ) , 


/ •  r_T_setc  •/ 
lot  T_T_satc{al,  o2  ) 
int  'olT  2,- 
\ 

tat  t  retld( J , 

buf f t  0|  «  • E'  , 

buff (II  -  •  w  , 

buff (21  -  ■/». 
switch  (  •  ol )  ( 

CM*  l- 

buff  m  -  ■  . 

buf  f ( 4 J  -  * l ' . 
brash . 

C«S«  2 : 

buf  f ( 3  )  -  A’, 

buf  f ( 4  I  -  ‘  2  ’  , 
brash . 

cssa  1 : 

buffd  I  *  •C*. 
buff (4  )  -  1 
brash , 

cssa  4  - 

buffOl  -  '  E '  , 
buff (4)  -  • 
brash , 

case  5: 

buffOl  -  'V, 
buff { 4 ]  -  ' 
brash, ) 

but f ( S ]  -  (  •  o2  --  0*  »  *0* 
buff (61  -  RETURN; 

/•  Uaah  (  vidao  ,  OL  ,  2  )  ,  •/ 

wr tta ( »ldao , buf f , 7 ) ; 
raturo<  v_retid( ) ) , 


' •  last  cossind  •/ 
tat  t  L( ) 

,  { 

bu  f  f ( 0 ]  -  •  L  *  , 
i  buff(l)  -  RETURN, 

/ •  lsaah ( Ttdao , OL , 2 ) ,  */ 

wrlte( Ttdao, buf f , 2 ) , 
rasdf Ttdao, buf f , 3  > . 

If  (buf f (i)  -  1 9' )  ( 

rasd(T<  ’ao.buff , 1) , 

rstum.  juff  Ol-'  O'  ) 

1 

else  returD( buf f ( 1 1  - ' 0 ' ) , 


!/•  soda  computer  •/ 


|  tat  t  NC( ) 

,  ( 

lot  t  cat ld( J , 
buff (01  •  'M* . 
buffdJ  -  'C'. 
buffOl  •  RETURN, 
!/•  laaah( Ttdao . OL, 2 l , 

I  wrtta< Ttdao, buf f, J ) 

ratuxa( v_ratid( ) ) , 

!  ) 

/*  aoda  taraloal  •/ 
lot  t  MT() 

( 

tnt  t  ratld( ) , 
buff ( 0 1  -  -M', 
buff [11  -  *T' , 

I  buff [2]  -  RETURN, 

!/*  Lsaah ( Ttdao , OL , 2 ) , 

wrlta( Ttdao, buf f , J ) 
ratura(T  retid()), 

|  1 

f/«  currant  fraaa  ouabar  •/ 

I  lot  t  N (  } 

'  l 

lot  t  rattd ( ) , 
buf f ( 0 1  -  N', 

buff (l |  -  RETURN. 

'/•  lsaah ( Ttdao , OL, 2 ) , 

wrtta( Ttdao, buf f , 2 ) 
raturnt T_rattd( ) ) , 

1 

/•  quit  •/ 
tot  T_Q( ) 

{ 

Lot  T  catld(  1 
buf  f [ 0 |  -  'O’, 
buff (11  -  RETURN. 

/•  Lsaah ( Ttdao, OL, 2 ) . 

wrt ta( Ttdao , buf  f , 2 ) 
return ( t  rattd( ) ) . 

1 

,/•  Z  coaasnd  * ' 
lot  T  Z(  ) 

;  ( 

tot  t  rat td ( ) > 
bufffOl  -  ’  Z‘ , 

buff (11  -  RETURN, 

,/•  lsaah ( Ttdao , OL, 2 ) ; 

wrlta( Ttdao, buff , 2 > 
raturafT  ratld< ) ) , 

) 

/•  Tptcfca  coaaand  •/ 
T_pteba< sua ,  carry) 

Lot  •nua, 
ebar  'carry. 


a 

*»*!■ 


I 

:$1 


m 


•v 

»»a 

i*S 


m 


/•  If  it  all  return  ia  th«r*,  it  would  only  b«  at  th«  end 
If  (cirryl'nui  -  11  *«  (3‘  ) 

carry ( • bus  -11-  RETURN . 
la««k  (Tld«o,  OL ,  2),  •/ 

writ*  (vld*o.  carry,  'aua), 


I/*  ▼_9tcha  coaaiad  •/ 
T_gtcQ*(ou»,  carry) 
(lot  * SUI; 
char  -carry. 


Lot  1, 

char  c, 

-pt, 

pt  -  carry, 

L t  ( • Qua  --  0 ) 

whila  (raad  (Ttdao,  fcc ,  1)  -•  1) 
if  (c  • •  • \ a* ) 

•pt-*  -  c . 

•la* 

return  (0), 

else 

Cor  (1*0,  i  <  'nua,  road  (wtd«o,  pt**,  1),  t**j. 


/•  r_fluah  coaaand 
.  *.,£luah{ ) 


char  c, 

whll«( r«ad( Ttdao , ac , 1 )  ■■  1), 


m  '•  %' 


V," 

w 

u 


i 


1 


...  Mod*:  LISP,  Syntax:  coaaoo-lisp,  Package:  USER ;  Baa*:  10.  -•- 

•  tapefnsla  .  Hap  * - 

This  ia  t he  tap*  drtxer  for  the  LAMBDA  LISP  lacblo*,  started  by  loading 

this  package  Tlui  package  is  COMMON  LISP  coapatlble. 

(  defxar  •  UZERO  •  *XJ0) 

(defvar  * uonc *  #xit) 

( defxar  • UTMO •  1*22) 

(defxar  *  UTRRE •  ixJJ) 

(defxar  *uroor*  »xJ4) 

( defxar  *urivc«  lx J  5  > 

( defxar  *USIX*  4xi6) 

( defxar  *  U  SEVE •  #xJ7> 

( defxar  •UEICB*  1x18} 

( defxar  «UNINE*  1x19) 

(defxar  *UA«  1x41) 

(defxar  •  UB  •  1x42} 

(defxar  *UC*  #X4 1 ) 

( defxar  *UO*  1x44} 

(defxar  *UE*  4x45) 

(defxar  *UF*  1x48} 

(defxar  *UC*  1x47) 

(defxar  »U8*  1x48} 

( d*  f  xar  • 0 1 •  1x48} 

(defxar  * U J •  I x4 A ) 

(defxar  »UE#  1x48} 

{ d • f  *  4  r  *  0  L •  4  x  4  C  ) 

(defxar  *  UM*  1x40} 

,d*tT«r  *  UN  *  1x4  E ) 

(defxar  *  L'O  *  I  x4  F  1 
(defxar  *UP«  I xSO  | 

(defxar  *UQ*  4x51  i 
i defxar  • UR •  4x52  ) 

(defxar  • US  *  1x52) 

(defxar  • UT •  1x54) 

(defvir  *  L'U  •  1x55) 

(defxar  *UV«  1x54  ) 

<  def xar  -UH»  1x5’  i 
i defxar  •UX*  1x58  i 
(d*fxar  *  UY  •  1x54 j 
(defxar  ■ U  2 •  I x  5  A ) 


( def xar 

• UNULL* 

1x0  0  ) 

■:  d  e  f  x  a  r 

•  RETURN • 

4x25) 

( def  xar 

•ENTER* 

1x25) 

.defxar 

*  STAR • 

4x2A) 

; def xar 

•COMMA  * 

f  x2C  ) 

; defxar 

•  SLASH • 

»xir ) 

i  defxir 

•COLON* 

•  X  3  A  ) 

(defxar 

• ATSGN • 

1x40) 

(defxar 

•  x  tdeo • ) 

( defun 

steal- port 

-b  (  > 

' do 1 1 a t  <d*x  Si  all- shar*d-d*xic*a ) 
(cond  (  |  strmq-aqual  *  SDU-SER  I  AL- B  ■  - 
(  send  d*x  □ as* )  ) 

;  sand  d*x  allocate  t) 

( rplaca  t  send  d*x  lock)  ml) 
i return  d*x ) ) )  )  ) 


f  d*  fun  xpl aydeao 1*1 (  ) 

( vi th-open- f l 1*  < »xtd*o»  - sdu- s*rlal-b : "  ) 

(send  * x tdeo *  set- baud- ra te  4400) 

(loop  (print  :exii  (r*ad)))))) 

(defun  xp 1  a ydeao sya (  ) 

( v i t h- open- s tr e •  ■  (•▼tdeo*  (Si  eak*~ serial- streaa 
unit  2 
baud  9600 

check-oxer- rua-*rrors  t 
aaci i -characters  t 
force-output  t)) 

'loop  (sag  (N  1)  ( • 1  (read)}))}) 

...(defun  aygetcbar ( ^optional  (n  1)) 

...  (let  ( ( }uofc  ( 1 L : exp lod*o  ( r ead-cbar ) ) ) ) 

...  (cond  v (equal  }unk  (141)) 

...  ( setq  }unk  (iLexploden  ( r*ad-c bar ) ) ) ) ) 

...  (do  ( ( ana  )unk  (append  ana  (ILexploden  (read-char)))) 

(  tap  L  (  1  ♦  tap  )  )  ) 

< ( •  tap  n  >  ana i ) ) ) 

(defaacro  xp-getcbar ( fcopt iooal  (n  l)) 

'(do  ((ana  nil  (cons  (send  *xtd*o»  tyi)  ana)) 
i  tap  0  (  *  L  tap  j  )  ) 

(<•  tap  ,0)  <nr*xerse  ana)))) 


, . , (defun  xp-putcbar( list 

...  ( asg  (1L  aaknaa  11*)  (N  1))) 


(defun  ayputbcbar ( L la ) 

dotlaea  (x  11*)  ; send  *xid#o* 


write  ail  the  chars  in  tb*  11* 


(d*fun  »p-re**t( ) 


.  .  flush  all  tb*  buffers  and  reset  the  port  so  the  user  can  reset 
if  in  cas*  lose  thing  goes  wrong. 


...  *  to  get  the  return  id  and  print  the  err  aag  if  any  •* 

(defun  xp-retid( ^optional  < nl  8)) 
let*  ((all  (xp-getchar  J)) 

>second  (cadr  all))} 

( cond  ((or  (■  second  *STAR»)  (  -  second  »DZERO»))  0) 

<(•  second  •uoNE*) 

■sg  l  “  illegal  coaaand  for  this  sicbia*  "  ail)  l) 

;(•  second  •WTWO*) 

(aag  1  "  Bad  coasaod  foraat  “  all)  2) 

((-  second  • UTHRE • ) 

(asg  l  "  Bad  option  foraat  ”  all)  i) 

((•  second  *CiroUR* ) 

(asg  1  "  Last  actlxe  coaaand  is  atill  actixe  "  all)  4) 
( ( -  second  -DRIVE* ) 

(nag  1  "  Coaniod  failed  ”  all)  5) 

((•  second  •DEIGI*) 

(■sg  1  *  Bad  aacbin*  cod*  *  all)  8) 

((and  (-  second  *UNINE*)  (*  nl  8)) 

(setf  all  (coos  (caddr  all)  (xp-getchar  4))) 


( vp-qetchar  4)  three  zeros  ana 
(c_to_l  all)) 

((and  7“  second  «UNINE«)  (-  ai  l)> 
( vp-getchar ) 


:hree  zeros  sod  a  carriage  return  char 


l  ( - 

ink 

•U2ERO* ] 

1 

(asg  •* 

No  active  comm 

and  * )  0) 

(  ( - 

ink 

• UONE  *  ) 

(asg  “ 

vp-ff  -) 

1) 

(  (- 

)nk 

•UTNO* ) 

(asg  " 

vp-g  -) 

2) 

(  c- 

ink 

•  UTHRE • 

)  (»»q 

-  vp-r  - 

1  i) 

( ( - 

ink 

•UFOUR* 

)  (»sg 

-  vp-i  - 

1  M 

l  (- 

Jnk 

•UFIVE* 

)  (asg 

-  vp-pf  - 

\  >) 

(  (- 

Ink 

•USIX* ) 

(asg  - 

vp~he  “ ) 

M 

(  ( - 

}  nk 

•USEVE • 

>  (asg 

-  vp- hd  “ ] 

1  7) 

u- 

ink 

•UEiGH ’ 

I  («sq 

"  vp-sf 

1  3) 

{ ( - 

Ink 

‘UNINE* 

i  <»sg 

-  vp-fr 

1  *)  )  )  ) 

Returning  undefined  code  ■*  all)  7)))) 

.  ,  ,  •  to  chaoge  char  to  integer  */ 

{deCun  c_to_i(lisj 

(do  (  (  an*  0  (  *  {■  aos  10)  (-  (car  tap)  ‘UZERO*))) 
( tap  Its  ( edr  tap  ) ) ) 

< ( null  tap )  ana ) ) ) 


...  *  to  seed  a  suabar  •/ 

{detaacro  vp- seodnua( x ) 

'(▼p-putchar  (exploden  ,  xjj) 

. , ,  / •  Cast  forward  • / 

(detaacro  vp- fast- forward* ) 

*  ;  proqn  •;  ) 

:vp-putchar  (list  *UF*  ‘UF* 

{ vp-retld) ) ) 

...  Caat  reverse  «/ 

(detaacro  vp-rewind() 

* ( progn ( ) 

(▼p-putebar  (list  *UF*  *  UR •  * 
( vp-retid) ) ) 


( vp-putebar  (list  *UF*  *UR  *  ‘RETURN*)) 

( vp-retid)  ) ) 

go  to  a  frame  number  ol.  fc  nl  is  on  off  flag  •/ 


,  ,  .  '  -  a  L  QUBUCl  Hi,  *i  U*  4  U  U  U  4  1  / 

(defun  vp-go-to- £rame( ^optional  ( nl  0)  (n2  l)) 

(vp-putchar  rcond  ((>  nl  0)  (list  *UG*  *  SLASH •  *UE*  *UONE*  ‘COLON*) 
(t  (list  *UG •  'SLASH'  ' VE •  * U  ZERO  *  ‘COLON*)))) 


( vp- sendnua  n 1 ) 

(vp-putchar  (List  ‘ENTER’)) 

( v  p— retld)  | 

, , ,  •  hold  disable  • / 

(detaacro  vp- ho ld-d l sable ( ) 

'  ( proqn (  ) 

( vp-putchar  (list  ‘UH‘  ‘UD‘  ’RETURN*)) 
( vp-retid ) ) ) 

...  *  hold  enable  •  - 

(detucro  vp- hold-enable(  ) 

' ( progn ( ) 

(vp-putcbar  (list  «UH*  *UE*  ’RETURN*) ) 
(  vp-retld  )  )  ) 


,  .  ,  ■  •  initialize  ■ ' 

(detaacro  vp- initialize(  ) 

' ( progn ( ) 

(vp-putebar  (list  *UI*  ‘RETURN*)) 

( vp- retld) ) ) 

.  .  .  »  play  forward 

.  .  .  nl  is  frame  number  to  start,  nl  is  (rase  number  to  end 
.  nl  -  0  starts  from  tbe  current  position,  (default) 

.  <  0  start  from  beginiog, 

.  .  .  nl  -  0  stops  at  the  end  (default)  , 

.  .  .  >0  stops  at  that  frame  number  < / 

(defun  vp-play- forward ( fcoptional  (nl  0)  (  nl  0)) 

(rp-putebar  (list  *up*  ‘Ur*)) 

(cood  ((-  nl  ))  (vp-putebar  (list  ’ENTER*))) 

((<  nl  •) )  (vp-putchsr  (list  ‘COLON*  ‘UZERO*)) 

cond  ((cond  ({•  nl  0)  {vp-putchar  (list  ‘ENTER*)) 
(t  {vp-putebar  (list  ‘COMMA*)) 
vp- sendnua  nl) 

(▼p-putchar  (list  ‘ENTER*))))))) 

-t  (vp-putchar  (list  ‘COLON*)) 
vp- seodoum  nl ) 

cond  ((■  nl  J)  ( vp-putebar  (list  ‘ENTER*))) 
ft  ( vp-putchar  (list  ’COMMA*)) 

(vp- seodoum  nl) 

(vp-putebar  (list  •  ENTER •))))  j  » 

: vp-retid) ) 

,  .  .  *  re  7  ect  * 

detaacro  vp-e} ec t- taper  ) 
f progm ) 

vp-putohar  (list.  •  «JR  •  ‘RETURN*  >) 
vp-retld) ) ) 

•  single  step  forward  a  frame  •' 

'  defaacro  to- s i ng le- f r aae<  ) 

proqn ( ) 

▼D-putcbar  !  list  *'JS‘  *UF*  ‘RETURN*  )) 

▼p- retld )  )  ) 

•  home  'M  -  4  2  0  • 

(defaacro  vp-boae<> 

•  let  ■:  t eap  i  ) 

vp-putchar  (list  • ATSGN •  ‘ENTER*)) 

sett  reap  ( Tp-qetcbsr i » 

cond  (equal  car  temp)  ‘STAR*)  0) 

it  (asg  ;N  l)  *  Returning  Undefined  code 


t*ap )  ■’)))) 


,  ♦  environment  read  • 

.  ..  *  argument  nl  can  be  video,  audio!,  audio) ,  videoend,  continuous  * 

(defun  vp- environment- read ( ^optional  (n  nil)) 

( vp-putchir  (list  ‘UE*  ‘UR*  ‘RETURN  j) 

(let*  ((all  ( vp- get char  ))) 
i second  (cadr  all))) 

(cond  ((or  <-  second  ‘STAR’)  f-  second  ‘UZERO* ))  0) 

((•  aecoad  *uowr* ) 

(msq  l  “  ILleo-  command  for  this  machine  "  all)  1) 
((•  secoad  *UT»'  ’ 


>t<l 


a 


(mag  1  *  Bad  coumd  format  :  "  all)  2) 

(<»  sac ond  -UTHRE*) 

(■•9  1  •  Bad  option  format  :  “  all)  2) 

((•  sacood  -uroUR*) 

(mag  1  *  Last  active  command  la  still  active  “  all)  4) 

((-  sacood  *uriVE«) 

(■aq  1  "  Command  failed  .  "  all)  5) 

((•  sacood  * UEXGH* ) 

(■aq  1  “  Bad  machine  cod*  :  "  all)  8) 

{(-  sacood  * UNINE* ) 

(setf  all  (cddr  (vp-getchar  7))) 

{vp-getchar)  ,  return  char 

(let  ((temp  (do  ((ana  nil  (cooa  (cond  ((»  (car  tmp)  *UZERO*) 

0) 

(tin 

ana)  ) 

(tmp  all  (cdr  tmp))) 

((null  tmp)  (orafarsa  ana))))) 

( cond  ((Dull  ol )  temp) 

(t  (let  ( ( teapl  (aapnama  ol))) 

(cond  ((-  tempi  0)  7) 

(t  (nth  (-  teapl  1)  temp ))))))) ) 

(t  (sag  1  “  Returning  undefined  code  :  "  all)  7)))) 


j (defun  aapoaae(xl) 

(cond  ((equal  xl  ‘video)  1) 

((equal  xl  audiol)  2) 

((equal  xl  'audlo2)  3) 

((equal  xl  'videoend)  4) 

((equal  xl  ‘continuous)  5) 

1  (t  (sag  ‘Illegal  first  arguaent  : 

{  ,  , .  /•  environment  write  •/ 

(defun  vp-environment-vrite(  nl  n2  n3  n4  n5) 
- — *“**■-•»  - -  «rra>.  .yM.  'SLASH  * 


(vp-putchar  (list  *«*.'  -«»»-  -slash'  -w »-|j 
(vp-putchar  (if  (■  nl  0)  (list  -UZERO*)  (list  • UONE • ) ) ) 
(▼p-putchar  (if  (-  n2  0)  (list  *UA*  -UONE*  *UZERO*) 
/!<«»■  •(>&<  «nnur>  •nr»wr«  \  \  \ 


(list  *UA*  *  UONE • 
(vp-putchar  (if  (•  n3  0)  (list 
(list  *UA-  • utwo* 
(vp-putchar  (if  (■  n4  0)  (list 
(vp-putchar  (if  (-  n5  0)  (list 
( vp-retid) ) 


'UONE' ) ) ) 

'  UA*  • UTWO*  *  UZERO  * ) 

'  UONE *  )  )  > 

-UE*  *UZERO* )  (list  • UE • 
■UC*  *UZERO*)  (list  *UC* 


•UONE* ) ) ) 
• UONE • ) ) ) 


iii  /*  vp-set  •/ 

(defun  vp-satfal  ^optional  (n2  1)) 

(cond  ((aeaber  nl  ‘(video  audiol  audio2  videoend  continuous)) 
(vp-putchar  (list  *UE*  *UW*  «SLASH«)) 

(vp-putchar  (cond  ((equal  nl  ‘video)  (list  «UV*)) 

((equal  nl  ‘audiol)  (list  *UA*  *UONE*)) 
((equal  ol  ’ aud io2 )  (list  *UA*  *UTWO*)) 
((equal  nl  vedioend)  (list  *UE«)) 

((equal  nl  continuous)  (list  *UC*)))> 
(vp-putchar  (list  (cood  ((or  (•  o2  0)  (-  n2  ‘off))  *UZERO*) 
(t  • UONE • ) )  -ENTER*)) 

(vp-retid)) 

(t  (asg  (N  1)  “  Illegal  first  argument  :  *  nl)))) 


,,i  /•  last  coamand  •/ 

(defascro  vp-last-commandf ) 

' (progn( ) 

(vp-putchar  (list  • UL •  -ENTER*)) 
(vp-retid  1) ) ) 


i  /•  mode  computer  •/ 

(defmacro  vp-aode-computer ( ) 

[  '(progn() 

( vp-putchar  (list  *UM*  *UC*  *ENTE 
(vp-retid))) 

I 

\  >  /•  mode  terminal  */ 

j (defmacro  vp-mode- termlnal(  ) 
j  *( progn <) 

(vp-putchar  (list  *UM*  *UT*  -ENTE 
|  (vp-retid) | j 

l ; ; i  /*  current  frame  number  •/ 

{(defmacro  vp- frame- number ( ) 

* ( progn ( ) 

(Vp-putchar  (list  *UN*  -ENTER*)) 
j  (vp-retid))) 

j i , i  /*  quit  •/ 

I  (defmacro  vp-quit( ) 
j  '( progn () 

!  (vp-putchar  (list  *UQ*  -ENTER*)) 

(vp-retid))) 

j . /•  Z  command  •/ 

(defmacro  vp- last-command-status( ) 

'( progn <  ) 

I  (vp-putchar  (list  *UZ*  -ENTER*)) 

( vp-retid) ) ) 


1 (defun  aapname(xl) 

(cond  ((equal  xl  ’video)  1) 

I  ((equal  xl  ’audiol)  2) 

((equal  xl  *audio2)  3) 

((equal  xl  ’ videoend)  4) 

1  ((equal  xl  ‘continuous)  5) 

J  (t  ( ssg  •‘Illegal  first  argument  to  vp-setc/getc  “)  0)>) 


(defun  vp-help() 

(meg  (N  1)  •*•*  The  following  functions  are  available  •*•■)) 


VIDEO  DISK  PLAYER 


Video  Disc 


Navetn  Hota 
JAYCOR 


Usage 

The  video  disc  can  be  operated  from  lisp.  The  routines  are  written  in  C. 
These  routines  should  be  loaded  into  lisp  before  using  them.  To  use  them  do  the 
following: 

set  the  EXT  switch  to  ’on'  on  the  backside  of  the  video  player,  switch  on  the 
video  player. 


On  VAX 

(load  'discfns) 

(vd-open) 

—  whatever  — 
(vd-close) 


On  LMI  ; 

(load  ’discfnslm)  ; 

(with-open-file  (*video*  "sdu:serial-b:")  i 

(send  *video*  ’:set- baud- rate  1200)  » 

—  whatever  —  ! 

)  j 

Some  times  this  won’t  work  due  to  the  serial-port  being  opened  by  someone  j 

and  forgot  to  close.  In  that  case  use  the  following:  j 


(with-open-file  (*video*  (steal-port-b) 
(send  *video*  ’:set-baud-rate  1200) 
—  whatever  —  ) 


On  Symbolics 

(load  ’discfnslm) 

(with-open-stream 
':baud  1200 


(*video*  (si:make-serial-stream 
’:check-over-run-errors  t 


’:unit  2 
hascii-characters  t 


bforce-output  t)) 

- whatever - ) 
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! 


Commands 

Following  is  a  description  of  each  of  these  functions  that  can  be  called  from 
lisp.  All  the  commands  return  an  integer  code.  A  returned  value  of  0  always  indi¬ 
cates  success.  For  other  values,  it  prints  an  error  message  and  returns  an  integer 
between  1  and  9. 

Name:  vd-open 

Arguments:  none 

Description:  vd-open  enables  device  communication  (only  on  VAX). 

Returns  0. 
vd-close 

none 

vd-close  disables  the  device  communication  (only  on  VAX). 
Returns  0. 

Extended  Commands 

Extended  commands  are  a  combination  of  the  basic  commands  used  often. 
They  are: 

Name:  vd-search-frame 

Arguments:  nl 

Description :  Searches  for  the  frame  nl  and  stills  there. 

nl  should  be  0  <  =  nl  =<  54000. 

Returns  0. 

Name:  vd-search-segment 

Arguments:  nl 

Description:  Searches  for  the  beginning  of  segment  nl  and  stills  there, 

nl  -  should  be  0  <=  nl  <=63 
Returns  0. 

Name:  vd-search-frame- repeat 

Arguments:  nl  n2  n3  n4 

Description:  Searches  for  frame  nl  and  repeats  n3  times,  playing  frames  nl  to 

n2  at  speeds  specified  by  n4. 
nl  -  beginning  frame  number 
n2  -  ending  frame  number 
n?  -  number  of  times  to  repeat  (lm:defauit  1) 
n4  =  0  -  normal  speed  (lm:defualt) 

=  1  -  fast 
=  -1  -  slow 

if  nl  >  n2  then  direction  is  backward, 

else  direction  is  forward. 


Name: 

Arguments: 

Description: 


-  3  - 


Vf*.' 


Name: 

Arguments: 

Description: 


Name: 

Arguments: 

Description: 


Name: 

Arguments: 

Description: 


nl  and  n'2  should  be  with  in  0  and  54000. 
n3  should  be  with  in  0  and  15. 

Returns  0. 

vd-search-segment-  repeat 

nl  n2  n3  n4 

Searches  for  segment  nl  and  repeats  n3  times,  playing  segment 
nl  to  n2  at  speeds  specified  by  n4. 
nl  -  beginning  segment  number 
n2  -  ending  segment  number 
n3  -  number  of  times  to  repeat  (lm:defualt  1) 
n4  =  0  -  normal  speed  (lmrdefault) 

=  1  -  fast 
=  -1  -  slow 

if  nl  >  n2  then  direction  is  backward, 
else  direction  is  forward, 
nl  and  n2  should  be  with  in  0  and  63. 
n3  should  be  with  in  0  and  15. 

Returns  0. 

vd-search-frmseg-repeat 
nl  n2  n3  n4 

Searches  for  frame  nl  and  repeats  n3  times,  playing 
nl  to  segment  n2  at  speeds  specified  by  n4. 
nl  -  beginning  frame  number 
n2  -  ending  segment  number 
n3  -  number  of  times  to  repeat  (lm:default  1) 
n4  =  0  -  normal  speed  (lm:default) 

=  1  -  fast 
=  -1  -  slow 

nl  should  be  with  in  0  and  54000. 
n2  should  be  with  in  0  and  63. 
n3  should  be  with  in  0  and  15. 

Returns  0. 

vd-segsave 

nl  n2  n3 

Sets  the  segment  number  nl  to  the  frames  n2  tp  n3. 
nl  -  segment  number  to  be  set. 
n2  -  beginning  frame  number 
n3  -  ending  frame  number. 

Returns  0. 


Basic  Commands 


Basic  commands  are  lower-level  commands.  The  user  can  program  using 
these  basic  commands  according  to  his  needs.  Each  individual  command  returns  0 
to  indicate  success.  The  user  has  to  check  the  returned  code  of  all  the  basic  com¬ 
mands  being  used  in  the  user  program. 

Marne  vd-sendnum 


A  rguments: 
Description: 


Ma  m  e 

.4  rguments: 
Description 


Marne: 


argl 

argl  should  be  an  integer  and  should  be  with  in  some  limits 
imposed  by  the  context. 

While  referring  to  a  frame  number  -  0  <  =  argl  <=  54000. 
While  referring  to  a  segment  -  0  <  =  argl  <=  B3. 

While  referring  to  repetition  factor  -  0  <  =  argl  <=  15. 

Returns  0. 

vd-play 

nl 

Plays  in  the  specified  direction  until  the  next  command. 

Direction  is  indicated  by  nl. 

nl  =  0  =>  backward,  and  n  1  =  1  =  >  forward.  (!m:default) 
Returns  0. 

Stops  at  the  end  or  beginning  of  the  disc. 

vd-fast 


Arguments: 

Description 


Marne: 


nl 

Fast  forwards/backward  the  disc, 
nl  =  0  =  >  fast  backward, 
nl  =  1  =>  fast  forward  (lm:default). 
Returns  0. 

Stops  at  the  end  or  beginning  of  the  disc. 

vd-slow 


Arguments: 

Description 


Marne: 

Arguments: 

Description: 


nl 

vd-slow  plays  slowly  in  the  f/b  direction. 

The  speed  is  1/3  of  the  normal  play  speed. 

nl  =  0  =>  play  backwards  slowly. 

nl  =  l  =>  play  forward  slowly  (lm:default). 

Returns  0. 

Stops  at  the  end/beginning  of  the  disc. 

vd-step 

nl 

vd-fstep  steps  one  frame  at  a  time  in  the  f/b  direction. 

nl  =  0  =  >  step  backward. 

nl  =  1  =>  step  forward  (lm:default). 


D 


<MfB 


! 


Name: 
Arguments: 
Description : 


Name: 

Arguments: 

Description 

Na  rn  e 

Arguments 

Description 

Name 

.4  rguments: 
Description: 

Name 

A  rguments: 
Description 


Name 

.4  rguments: 
Description 


Returns  0. 

Stops  at  the  end  or  beginning. 

vd-scan 

nl 

vd-fscan  scans  in  the  f/b  direction  at  a  speed  of  30  times  the 

normal  play  speed. 

nl  =  0  =>  scan  backward. 

nl  =  I  =>  scan  forward  (lmrdefault). 

Returns  0. 

Stops  at  the  end  or  beginning. 

vd-stop 

none 

vd-stop  stops  the  active  command  that  is  executing. 

Ret  u  ns  0. 

vd-enter 

none 

vd-enter  is  used  to  separate  individual  commands. 

Returns  0. 

vd-ce 


vd-ce  is  used  to  cancel  the  last  input  while  giving  commands. 
Returns  0. 

vd-menu 


Gives  a  menu  on  the  screen. 

The  disc  should  have  menu  choice  recorded  in  it.  (None  of  the 
current  discs  have  this.) 

Returns  0. 

Tries  to  find  the  menu  and  may  not  stop  finding. 

At  times  it  stops  at  some  frame  number. 

Use  vd-cl  to  cancel  this  command,  if  it  seems  to  tm  not  stooping. 

vd-search 

none 

This  is  used  to  search  a  frame.  Won’t  work  as  an  individual 
command.  Use  vd-search-t’rame.  This  is  used  in  combination 
with  other  commands  to  search  a  frame  or  a  segment, 
example: 

(vd-search)  ;  search  mode 

(vd-sendnum  nl)  ;  frame  number  to  be  searched 


WOT 


(vd-enter)  :  indicate  the  completion  of  the  command 
Finds  frame  number  nl.  and  returns  0. 

Name:  vd- repeat 

Arguments:  none 

Description :  This  is  used  in  combination  with  other  commands  to  repeat 

some  frames  or  segments.  Won't  work  individually, 
example: 

(vd-search- frame  1000)  :  go  to  frame  number  1000 
(vd-repeat)  ;  repeat  mode 

(vd-sendnum  2000)  ;  till  2000th  frame 

(vd-enter) 

(vd-sendnum  2)  ;  repeat  2  times 

(vd-enter) 

plays  the  frames  1000  to  2000.  2  times. 

Returns  0. 

Same  vd-segment 

Arguments :  none 

Description  Used  in  combination  with  other  commands. 

Example:  (vd-segment)  ;  segment  mode 
(vd-sendnum  2)  ;  segment  number 

(vd-enter) 

(vd-sendnum  200)  ;  beginning  frame  number 
(vd-enter) 

(vd-sendnum  300)  ;  ending  frame  number 
(vd-enter) 

Memorizes  segment  2  to  be  from  frames  200  to  300. 

Returns  0. 

Name  vd-chl 

Arguments:  nl 

Description  vd-chl  changes  the  staus  of  audio  channel  1. 

Depending  on  the  value  of  nl,  it  toggies/on/off  the  status  of 
audio  channel  1. 
nl  <  0  —  toggles  (lm:default) 
nl  =  0  —  turns  off  (regardless  of  previous  status) 
nl  >  0  —  turns  on  (regarless  of  previous  status) 

Returns  0. 

vd-ch2 
n  1 

vd-ch2  changes  the  status  of  audio  channel  2. 

Depending  on  the  value  of  nl.  it  toggles/on/otf  the  status  of 
audio  channel  1. 


Same 
A  rgumenls 
Description 


-  i 


I 


Name: 

Arguments: 

Description: 

Name: 

Arguments: 

Description: 


Same: 
Arguments : 
Desc  nption: 


Arguments: 

Description 


Same 

Arguments: 

Description 

Same: 

Arguments: 


nl  <  0  —  toggles  (lm:default) 

nl  =  0  ~  turns  off  (regardless  of  previous  status) 

nl  >  0  —  turns  on  (regarless  of  previous  status) 

Returns  0. 

vd-still 

none 

Freezes  at  the  current  frame. 

Returns  0. 

vd- index 
nl 

The  index  when  turned  on,  displays  the  current  command,  status 
etc  in  a  small  rectangle  in  the  upper  left  corner  of  the  screen, 
nl  =  -1  =  >  toggles  index  (lm:default). 
nl  =  0  =>  turns  off  index, 
nl  =  1  =>  turns  on  index. 

Returns  0. 

vd-dumpin,  vd-dumpout 

addl 

addl  is  the  address  of  a  block  containing  1024  bytes. 

These  are  used  to  send/receive  a  block  of  1024  bytes. 

Won't  send  any  return  code  in  acknowledgement. 

Have  to  send  1025  bytes  and  get  error  code  as  an  acknowledge¬ 
ment  (returned  code). 

Returns  error  code. 

vd-cl 

none 

vd-cl  clears  the  previous  command.  This  is  used  when  the  previ¬ 
ous  command  has  errors  in  it. 
example:  (vd-search-frame  1000) 

(vd-search-frame  2000) 

The  second  command  won't  be  executed  if  enough  time  is  not 
lapsed  between  the  first  and  second  search.  To  clear  the  second 
command  use  vd-cl. 

vd-pgm,  vd-pgmend,  vd-run,  vd-end 
none 

Used  to  start,  run  and  end  a  program. 

Can  do  the  programming  in  lisp. 

vd- memory 


mcMM 


-  8  - 


Description:  Memorizes  the  current  frame,  which  can  be  called  later  by  vd- 

msearch. 

Returns  0. 
example:  (vd-play  l) 

say  we  are  at  1202th  frame. 

(vd-memory)  memorizes  this  frame. 

&  the  play  continues  and  stops  at  the  end. 

Now  (vd-msearch)  would  take  back  to  1202th  frame, 
vd-memory  can  remember  only  one  number. 

Always  the  current  number  replaces  the  previous  number. 

Name:  vd-msearch 

Arguments:  none 

Description:  Used  to  find  the  previously  memorized  frame. 

Returns  0. 

Name:  vd-skip 

Arguments:  none 

Description:  Used  to  skip  a  frame.  Usually  used  after  vd-still  to  look  at  the 

next  frame. 

Returns  0. 

Name:  vd-int 

Arguments:  none 

Description:  Initializes  the  player,  puts  the  head  at  the  beginning  of  the  disc 

and  turns  on  audio  channels  1&2. 

Returns  0. 

Name:  vd-review 

Arguments:  none 

Description:  Its  a  control  instruction.  Returns  0. 

Name.  vd-mode 

Arguments:  nl 

Description.  Depending  on  the  value  of  nl  it  sets  the  mode. 

nl  =  -1  toggles  between  frame  mode  and  segment  mode 
(lmrdefault) 

nl  =  0  sets  to  frame  mode, 
nl  =  1  sets  to  segment  mode. 

Returns  0. 

Name  vd-continue 

Arguments:  none 

Description  Used  to  continue  the  previous  operation  after  a  vd-still. 

Returns  0. 


Name: 

Arguments: 

Description: 


vd-motor 

nl 


Turns  the  motor  on/off 
nl  =  0  =>  off 
nl  =  1  =  >  on  (lm:default) 
Returns  0. 


diacf a*  1 


Thia  set  of  LISP  calls  reads  in  and  binds  LISP  function  dims  to 
tha  C  coda  which  actually  doaa  tha  work.  Run  ooca  at  startup  time. 


(cfasl  ' /u«c/loc»i/ltb/*ldao/*dlac.o  ' _a^open  ' ad-open  " integer- function 


'  ( gataddrass 
j ( gataddrass 
( 9ataddraaa 
j ( gataddrass 
'  ( gataddraas 


,a_close  ad-close  “  intagar- function"  ) 
SetTera  ’»d-sat  " Intagar- function" ) 
RatTara  »d-raaat  “integer-function") 
▼_ratid  ad-retid  ••  intagar-  function"  ) 
asendnuja  1  *d-»andnua  *  intagar-  function- ) 


{ gataddraas 
( gataddraas 
( gataddraas 
•  (  gataddraas 
(  gataddraas 
(  gataddraas 
{  gataddraas 
( gataddraas 
{ gataddraas 
{ gataddraas 
( gataddraas 
{ gataddraas 
( gataddraas 
( gataddraas 
( gataddraas 
( gataddraas 
( gataddraas 
( gataddraas 
( gataddrass 
{ gataddrass 
( gataddraas 
( gataddrass 
'  (  gataddrass 
{ gataddrass 
( gataddrass 
( gataddrass 
{  gataddrass 
.  ( gataddrass 
( gataddrass 
( gataddrass 
<  gataddrass 
( gataddrass 


▼_tero  ad-zero  - Intagar- function- ) 
a_pi*y  • ad-play  " integer- function " ) 

»_fast  ‘ad-fast  “ integer- function" ) 
a^slow  ad-slow  “ intagar- function" ) 
a_stap  ad-step  "integer-function") 
a^scan  ad-scan  " in tagar- function " ) 
a^stlll  1  ad- still  “ Integer- function" ) 
a__stop  ad-stop  *  integer- function" ) 
a_entar  ad-enter  “ intagar- function" ) 
a__ca  1  vd-ca  "  intagar-  function"  ) 

*_Mdu  ad-aenu  "  Intagar- function"  ) 
a_saarch  'ad-saarch  " intagar- function" ) 
a_rapaat  'ad-rapaat  " intagar- function" ) 
a^segaaat  ad-sagaant  “  in  tagar- function'' ) 
*_chl  ad-chl  “ intagar- function" ) 
a_chl  ad-chl  " in teger- function" ) 
a_mdax  ad-iodax  “ intagar- function " ) 
a_du»pin  ad-duapin  “  in  tagar- function"  ) 
a_du*pout  - ad-duapout  " In tagar- function" ) 
a_cl  ad-cl  " intagar- function" ) 
a_pg»  ’ ad- pg-a  “ l n tagar- function" ) 
a_run  ‘ad-run  “ intagar- function" ) 
a_and  ‘ad-and  " intagar- function" ) 
a_aemory  ' ad-meaory  " in tagar - func tion" ) 
a_as«arcb  ’ ad-nsaarch  " in tagar- function" ) 
a_skip  ad-skip  " integer- function" ) 
a_tot  ‘ad-int  “ intagar- func tion"  ) 
a_caa law  ‘ ad-raaiew  " in tagar- function" ) 
a_aode  ad-mode  " intagar- function" ) 
a_continua  ' ad-continua  " integar-functioo" ) 
a__aotor  ‘ad-aotor  "  lotegar-functloo"  ) 
a_sleap  ‘ad-sieap  " integer-function” ) 


(gataddrass  • _a_saarch_f raae  ‘ ad- saa rch- f r aaa  " integer- function" ) 
(gataddrass  _a_search_segaent  ‘ ad- search- segaen t  " intagar- func tion" ) 
(gataddrass  ' _a_searcb_fraae_repeat  ' ad- search- frame- repeat 

" Intagar- function"! 

(gataddrass  1 _a_search_segaeot_repeat  1  ad- search- segment-repeat 

" integer- function"! 

(gataddrass  * _a_search_traaeg_repeat  ‘ ad- search- f raseg-repeat 
" integer- function"! 

(gataddrass  ’ _a_segsaae  ad-segsaae  " in teger- func tion " ) 


TdilCC 


rm*  s*t  of  C  function*  is  loaded  lb  by  tb*  Lisp  cod*  la  “dlsctos .  I 
and  do**  th*  acttual  work  of  th*  LISP  functtoos.  Coaptle  with: 

cc  -0  -c  vdlsc.c 


Itnclude  ^sgtty  h> 
Id* f la*  UNULL  0x00 
ld*flD*  UCONP  OxOi 
|d*fia«  UERRO  0x02 
#d*fin*  UPCXE  0x04 
ld*f l o*  UNTAR  0x05 
ld*f  In*  (JACK  Ox 0 A 
ld*r  to*  t  N  AC K  OxOB 
t d*  £  to*  U2ERO  0x30 
I d* f 1 o *  UONE  0x3  L 
I d*  floe  UTWO  0x32 
j ld*f  to*  UTHRE  0x33 
•d*f in*  UFOUR  0x34 
Id* f  to*  UfIVC  0x35 
ld*f  toe  L'SIX  0x3  6 
ld*f to*  USEVE  0x3  7 
'  ld*f  to*  L’EIGU  0x38 
ld*f in*  UNINE  Ox  3  9 
Id*  f  t  o*  UFPLA  Ox  3 A 
I d*  f  t  o«  UFFAS  0x3 B 
ld*f  to*  UFSLO  0x3C 
Id*  f  t  o*  UFSTE  0x30 
Id*  f  t  O*  UFSCA  0x3  E 
I d*  Cine  US TOP  0x3F 
Id* f  to*  UENTE  0x40 
Idafto*  UCE  0x4  L 
ld*fto*  L'MCNl'  0x42 
Id*  f  to*  USEAR  0X4 3 
Idafto*  CREPE  0x44 
ld*f  toe  USEGM  0x45 
Idaftn*  UCHlN  0x46 
Idafto*  UcatF  0x4  7 
Id*  fin*  UCR2.V  0x4  3 
Idefiae  UCH2F  0x49 
Id*  fine  URPLA  0x4A 
Id*  fin*  UREAS  0x4  B 
I d*  f  t  o •  URSLO  0x4C 
Ideftn*  URSTE  0x40 
Idafto*  URSCA  0x4  E 
ld*f in*  USTIL  0x4  F 
•derto*  U I NON  0x50 
Id* f  t  o*  UINDF  0x51 
♦define  UDUMN  0x52 
#d*f in*  GDUMT  0x53 
•d*fto*  USEMO  0x54 
Idafto*  U FR Art  0x55 
Id* f  t  o*  UC  L  0x5  6 
ld*f  to*  UPGM  0x5? 
,  Id*  f  to*  UR UN  0x58 


I d*Z  to*  UREVI  Ox 5E 
•d*rto*  UMODE  0x5r 
ld*f to*  U ADD!  0x60 
ld*f to*  UCONT  0x61 
I d* f  L  O*  UMOTN  0x6  2 
IdeftQ*  UMOTF  0x63 
ld*f to*  UCBl  0x64 
ld*f  1  o*  (JCB 2  0x65 

♦d*fto«  UINDE  0x66 
ld*f  to*  USTAI  0x67 
ld*f  to*  UDISI  0x68 

static  tot  video, 

char  *tbuf, 

v_op«o< ) 

( 

tot  SetTeraf ) . 

if((vtd*o  ■  op*o( ■ /d«T/ ttytO" ,  2)j  <  Oj  return  (-1), 

S*tT*r*( ) , 
rttur o ( o  j , 

I 

*  ctos*( > 

I  ~ 

toe  RstTerar  j . 

RstT*ra< ) . 

•z  Loa*(  video  )  . 
r*turn( 0  >  , 

► 

struct  aqttyb  o  ldaodes  ,  o*v*od«s  , 

S*tT*r»f ) 

f 

toctlf video.  TIOCGETP,  toldaod**), 
toct 1 ( v id*o  TIOCGETP.  to*waod*s), 
i«v«od«i  sq^flaqs  •  RAM. 
o*waod*s  sq_fla<js  fc-  'ECHO. 
n«waod«s  sq_isp**d  -  BL200. 
n*w»od*s  sq,osp**d  •  B1200, 
loot l < vtd*o .  TTOCSETN,  tn*vaod*i) , 

I 

< 

locti(vtd*o,  rrOCSETN .  fcoidaod**), 

J 

lot  »  r*tld( ) 

l 

t  at  v_cl( ) , 

r*«d  ( vld*o. tbuf . 1 ) , 

switch  { »tbuf ) { 

cas*  ' 0 ‘ 


ci««  UNULLr 
case  UACI 
CIM  UCOMP 
c«si  UPC  ME 

r«tura( 0 } , 

C«l«  UNTAR: 

prlot((  'auMfier  not  found\n'*). 

*_Cl(  )  . 
rtturm  1 ) . 

C4f«  UERRO ; 

printf!  “  Invalid  coMind\n“), 

) - 

return!  2  )  i 
cut  UNACK 

print?  ( "eoaaand  not  id  valid  rangeyo**). 
"_Cl<  }  . 
rttur o( 1 )  . 

Je  t  aul  t 

pr  intf ( *  returning  undefined  coda  %x\o" 

*_<U<  >  , 
raturoi 5 > . 


t  ipuccoiri x ) 
a  r  x . 


mt  7_ret.J(  ), 
vr t  te  <  v idao . «  x , l )  . 
return i  v  r et id!  ) ) . 


Lot  y.teap.v  ratld( ) , 

mar  bu  f  t  f  1  5  J  7 

y  -  •  x . 
if  !  y  --  0)  ( 

buff [01  ■  0-. 

wr i t« ( v ideo .buff, l ) . 

ratura  (v_retid()), 

) 

whlLe  <  y  >  0  4b  bt  >•  0)  ( 

buf f (bt-- ]  -  y  *  10  *  *  O' , 
y  -  L  o , 

* 

while  i bi  <  14  )  [ 

vr i te{ video .  buff*bi»l.  1), 


0)  returD(tenp) 


return( teap> , 
t  v_iero< ) 


int  aputcbar ( ) . 
return! aputcbar ( U2ERO ) ) . 


u  u 

a  a 

V_play( ol  ) 

•  nl . 

! 

lot  aputcbar ( ) , 

raturni ■putcbar( ( • nl  >  0) 

»  UFPLA 

:  URPLA) ) 

H  *i 
a  o 

v_f ast! nl ) 

•  nl . 

) 

Int  aputcbar ( ) , 

return! aputcbar ((* nl  >  0) 

*  UFFAS 

:  URFAS ) ) 

int 

int 

v_*low( nl ) 

•  ol , 

) 

int  aputcbar ( ) . 

return ( aputcbar ((* nl  >  0) 

’  UFSLO 

URSLO) ) 

lot 

int 

*.st#p| nl ) 

•  nl  , 

) 

int  aputcbarc ) . 

return ( aputc bar (/• nL  >  0 ) 

->  tJFSTE 

URSTE ) ) 

lot 

int 

v_scao! nl > 

•  n  l . 

) 

int  aputcbar ( ) . 

return ( aputcbar! ( *nl  >  1 ) 

’  UFSCA 

t’RSCA )  ) 

int 

▼_*tlll! ) 

1 

int  aputcbar! ) , 
return! aputcbar! USTIL) ), 

lot 

*.*top| ) 

) 

Int  aputcbar! ) , 
return! aputcbar! US TOP ) ) . 

lot 

v_antar( ) 

Int  rt . aputcbar ( J , 
rt  *  aputcbar ( UENTE ) , 
sleep! 1 ) , 

V  LV.*3« 


return ( r: ) / 


ft 

•c*  < 


tot  T  C«(  ) 

( 

tnt  aputchar < > , 
rttuiD { aputchar! UCE ) ) , 


lot  ▼  MDU(  ) 

{ 

lot  aputchar ( ) , 
return<aputchar(UMENU) ), 


'  iot  t  saarch( ) 

!  { 

lot  aputchar!)/ 

j  returo(aputchar ( USEAR) )  ; 

!  I 

I  tnt  v  repeat ( ) 

1  { 

lot  aputchar ( > , 
return (aputchar ( urepej ) / 


tnt  e  segaaotf ) 

{ 

lot  aputchar! ), 
retutDi aputchar (USEGM) ) / 


; Int  v^chl ( nl ) 
tnt  *nl. 

i  ( 

lot  aputchar ( ) ; 

return{aputchar  ( { *al  >  0 )  *  tJCHlN 
(  *  o  1  --  0)  ■*  UCHJ.F  :  UCH1  )  )  , 

: } 


lnt  v_ch2(nl) 


lot  aputchar! ) ; 

return! aputchar (( *nl  >  0}  ?  UCH2N 
(*nl  --  0)  -»  UCH2F  :  UC3  2 )  )  , 

J 


tot  T_lndex(nl) 
lot  »nl, 
l 

lnt  aputchar ( ) / 

retur n ( aputchar ( ( ’ n 1  >  0)  ?  UINDN 

(*Ol  --  0)  ?  UINDF  :  UXNDE))/ 

J 


lnt  *_duapin( ) 

( 

Lnt  aputchar ( ) , 

return ( aputchar ( UDUMN ) ) ,• 

) 

tot  T_du»pout< ) 

( 

tot  aputchar!}/ 
return( aputchar ( UDUMT) ) , 

\ 


i lot  v  cl< ) 

;  1 

tot  aputchar ( ) , 
re turn( aputchar  (  UCL) )  ; 

;  l 

tot  T_pga( ) 

!  ( 

j  tot  aputchar (  ) , 

return ( aputchar ( UPCM) ) t 

.  ) 

tnt  ▼  run (  ) 

,  ( 

tot  aputchar  (  ) 

i  returnf aputchar ( UFUN ))  , 

;  > 

I  tnt  *  end! ) 
f 

I  tot  aputchar!}, 

return!  aputchar  (  VEND )  ) 

) 

tnt  »_ae»ory (  ) 

( 

tnt  aputchar!  )  ,■ 

i  return! aputchar < UHEMO) ) , 

i  ) 

tnt  t  aeearch! ) 

i  ( 

Lot  aputchar!)/ 
return! aputchar ! UMSEA )) . 

;  ) 

j  lot  T_sltlp!  ) 

lot  aputchar!)/ 
return! aputchar ! OSKIP ) )/ 

> 

let  f  tat< ) 

( 

l^t  aputchar! ) • 

return ! aputchar (CIMT) ) , 

I 


;  lot  t  reeiev< ) 
f 

Lot  aputebar ( ) , 

rvtuiD <  aputc bar ( UREVI ) > . 


i tot  r_aode< ol ) 
tot  *  ol , 

{ 

tot  aputebar (  )  , 

return { aputebar ( ( • nt  <  0)  7  UMODE 
{-01  --  0)  7  UrRAN  USENO)). 


iot  r  continual ) 

{ 

tot  aputebar  ( } , 
raturni aputebar ( UCONT) ) , 


int  T_aotor(nl) 
tot  *01. 

( 

tot  aputebar ( ) , 

raturnf aputebar (( «nl  >  0)  7  CMOTN  UMOTP)). 


lot  v_sleep( ot ) 
rot  • nl , 

!  ( 

'ol  •  (  'ol  <  0)  7  -  *  ol  'Ol, 

sleep! ' nl  )  . 

return(O). 

) 

tot  7_searcb_f raae(  tma) 

'tot  *  nua . 

.  I 

tot  rz  ,  aputcbar(  )  ,  7_seodnua(). 
tf  ('nun  •:  0  i  ;  'nua  >  34000)  returo(4). 

If  ((rz  •  aputebar ( USEAR ) )  >  0)  raturn(rz), 
it  Mr;  »  r^seodnuac nua ) )  >  0)  returo(rz), 
r;  *  aputebar { UENTE ) . 
sleep! 2  )  , 
returo( rz ) , 


lot  7_search_segoeot( nua) 
int  'qui. 

( 

tot  rz, aputebar () ,  v_sendoua<), 

tf  | 'nua  <  0  j  *nua  >  61)  return(4). 

tf  ({rz  -  aputebar { 0SEAR ) )  >  0)  return(rz). 

if  ((rz  -  aputebar ( UMODE) )  >  0)  returo(rz), 

tf  ((rz  -  »_sandeua( nua) )  >  0)  returo(rz). 

rz  -  aputebar ( UENTE ) , 

sleep( 2) , 

return ( rz) , 

) 


7_ sear c b_ f raaa_ repeat ( boua. and nua , otaes , speed ) 

•boua,  *  eodnua .  *ntaea,  'speed, 

tot  sign,  rz , aputebar (), r_jeodoua< ) , 
ebar  speedc. 

If  (*bnua  <  0  I |  *bnua  >  54000  • 1  * eodnua  <  0  |  'endnua  >  54000) 

return( 4 ) , 

tf  ((stgo  -  T_searcb_fraae( boua) )  >  0)  return! sign) , 
stgn  •  ('boua  >  'endnua)  ’0:1, 

*ntaes  •  (’Otaes  <  0  !|  *otaes  >  15)  7  L5  *otaes. 

If  ( ( rz  •  aputebar ( UREPE ) )  >  0)  return(rz), 
tf  ((rz  -  7_iandnuo( eodnua ) )  >  0)  return(rt), 
tf  ( *  speed  --  - L  64 

( ( rz  -  aputebar (( sign  ••  0)  7  urslo  :  UTSLO) )  >  0))  return(rz). 
tf  ( • speed  »•  1  u 

<(rz  -  aputebar (( stgo  ••  0)  7  UREAS  :  UPPAS))  >  0))  returo(rz), 
tf  ((rz  *  aputebar ( UENTE ) )  >  0)  returo(rz), 
tf  ((rz  •  ▼_ sendnua ( ntaei ) )  >  0)  returo(rz), 
return ( aputebar ( UENTE ) j , 


rseirch^segaeot  repent! snual , soua2 , ntaei, speed) 

*s oual,  *soua2,  'ntaei.  'speed. 

Lot  rz.slgo, aputebar ( ) .v^sendouai ) , 
tf  (*soual  <  0  ,  j  »soual~>  63  •  j 

* snual  <  0  !!  *  snuai  >  61)  returo(4). 
tf  {(rz  •  r_searcb_segaeot( snual ) )  >  0)  returo(rz), 

•ntaei  -  ('otaes  < ~0  'ntaei  >  L5)  7  15  'ntaei, 
algo  -  Manual  >  * snuai )  7  0  L, 

tf  ((rz  •  aputebar ( URCPE ) )  >  0)  return(rt), 
tf  ( ( rz  •  TieodDuai a ouai ) )  >  0)  return! rz) , 

tf  ( - apeed  -•  - L  u 

( ( rz  •  aputebar (( stgo  0)  7  URSLO  UPSLO) )  >  0))  return! rz ) . 

tf  ( • speed  ••  L  64 

!(rz  •  aputebar! ( stgo  0 )  7  URPAS  UTrAS))  >  0))  return! rt). 
tf  ( ( rz  -  aputebar ( UENTE ) )  >  0)  returo(rz), 
tf  ! ! rz  -  raeadoua( otaes ) )  >  0)  return(rz), 
return <  aputc oar ( UENTE ) ) . 


_searcb_freaeg_repeat( f nua, soua. ntaei . apeed) 
f  nua ,  *  soua ,  'ntaei ,  'speed/ 

lot  rz , aputebar {>, seodnuaf ) , 
ebar  apeedc, 

tf  (  'nua  <  0  I|  'iiua  >  41  |  |  *faua  <  0  {  j  >faua  >  54000)  returo(4) 
tf  ( ( rt  -  sea rc b _ f r iae ( f nua ) )  >  0)  retura(rz), 

•ntaei  •  ( ‘ntaei  <  0  U  •ntaei  >  15)  7  15  •ntawi, 

If  ((rz  -  aputebar ( UREPt ) )  >  0)  returi(rz). 

If  ((rz  -  aputebar (UHODt) )  >  0)  return  (rz), 

tf  ((rz  -  ▼_aeadaua( inua) )  >  0)  return! ri ) , 

If  ( • apeed  ••  -1  44 

(rz  -  aputebar (UPSLO) )  >  0)  return (rz), 

elae  if  {'speed  ••  1  44 

(ft  •  aputebar ( UPPAS ) )  >  0)  return! rz). 


i>Vv‘  i'v. 


*od«:  LISP;  Syntax:  cohod-  1  lap,-  Pacfcaga-.  USER;  10. 


j.  dlscfnala. lisp 

I.  This  u  tha  packaga  of  functtona  which  tntarfacas  tto  tha  disk  playar 
fro*  tha  LAMBDA  aac&ioa .  It  is  COMMON  LISP  coapatibla. 

j  < daf rar  •  UNULL *  1x00) 

I (dafrar  «UCOMP*  #xGl) 

[ (dafrar  *UERRO«  1x02} 

I (dafrar  «UPGME«  *x04) 

[(dafrar  • UNTAR  *  t xOS ) 

' ( dafrar  • U  AC  t *  «xQA) 

,  (  dafrar  *UNACK«  *xQB) 

{dafrar  ’ULERO*  *x30) 

; (dafrar  •UONE*  1x31) 

' (dafrar  *UTWO*  1x32) 

I (dafrar  * UTHRE *  ix33) 

(dafrar  *UFOUR*  *x34) 
j  (dafrar  *urivt*  *x35) 

(dafrar  *usrx*  #xJ6  ) 

'(dafrar  «U5EVE*  1x37) 

(dafrar  "UEIGH-  1x38) 

I (dafrar  *  UNINE •  1x39 ) 

1 (dafrar  *UFPLA*  IxJA) 

! (dafrar  * UFFAS •  *x3B) 
i (dafrar  •UPSLO*  »xJC) 
i (dafrar  • U  FSTE •  IxiD) 
i (dafrar  «UFSCA«  lx3E) 
i (dafrar  ‘USTOP*  Ix3p) 

: (dafrar  * UENTE •  1x40) 

.'(dafrar  ’UCE*  #x4lj 
i (dafrar  '(/MENU*  »x42) 

, (dafrar  *USEAR*  8x43) 

(dafrar  «UREPE*  1x44) 

(dafrar  «USEGM*  1x45) 

(dafrar  •QCH1N*  8x46) 

I (dafrar  •UCflir*  8x47  ) 

(dafrar  »UCH2N»  1x48) 

.(dafrar  »UCH2F*  1x49) 
j (dafrar  "URPLA*  8x4A) 

(dafrar  *URFAS*  8x4B) 

{(dafrar  •VKSLO*  8x4C) 

.(dafrar  • URSTE •  8x4D) 

(dafrar  *URSCA*  8x4E) 

| (dafrar  'USTIL*  »x4F) 

({dafrar  ■ U ISDN  *  #x50) 

((dafrar  -UINDF’  txSl) 

(dafrar  -UDUmn-  8xS2) 

! ( dafrar  »UDUMT«  8x53) 

[(dafrar  *USEMO«  8x54) 

( (dafrar  • OFRAM*  #xSS) 

; (dafrar  «UCL«  8x56 ) 

(dafrar  •  VPGS*  8xS7) 

(dafrar  *URUN*  «x58> 

!  (dafrar  «VEND«  1x59 ) 

|  (dafrar  * UMEMO •  8xSA) 

((dafrar  *UMSEA*  IxSB) 

I  (dafrar  *USKIP«  8xSC) 


: (dafrar 
| (dafrar 
| (dafrar 
, (dafrar 
| (daTrar 
! (dafrar 
!  (dafrar 
[  (dafrar 
| (dafrar 
I (dafrar 
1 (dafrar 
| (dafrar 


•UINT-  8  xSD ) 

*  UREVI •  I x5E ) 

*  UMODE  *  8x5F) 

*  UADDI *  1x60) 
•UCONT*  1x6  I ) 

*  UMOTN •  1x62 ) 
• UMOTF*  1x63) 

*  UCH1  *  »X64) 

*  UCH2  *  1x6  5) 

•tJINDE*  #X66) 
• USTAI •  1x67 ) 
"VDISX*  1x68 ) 


(dafrar  »rldao*> 

(dafun  staal-port-b  (  ) 

(doilst  (dar  si : all-sharad-daricas ) 
(cood  ( ( str 1 ng-«qual  “ SDO-SERIAL-B : - 
(sand  dar  :aaaa) ) 

( sand  dar  : allocata  t) 

( rplaca  (sand  dar  :locfc)  oil) 

( raturn  dar) ) ) >  > 


(dafun  rdl*cdaBolal( ) 

]  ( vtth-opoo-f ila  ( *ridao«  “ sdu- sar ial-b : " ) 

,  (300 d  ’rldao*  : jat-baud-ri ta  9600) 

l  (loop  (print  (arnl  (raad)))))) 

l 

; (dafun  rdlscdaBOsyaf ) 

(  vlth-opan-straaa  cniao*  ( si : aaka-sarial-straaa 
•  unit  2 
1 : baud  9600 

• : cbacfc-orar-ruu-arrors  t 
asc 1 i-c har ac tar s  t 

i  : forea-output  t) ) 

(loop  (Bag  (N  D  <  ara l  (raad)))))) 


'' i  i  i  (dafun  aygatchar(  ) 

! i»i  (car  (ZL:axplodan  ( raad- char )))  ) 

, (dafaacro  aygatcbar( ) 
i  '(sand  «ridao*  ’tyi)) 

,,,, (dafun  ayputcbar ( a ta  ^optional  (n  0)),slaap  tiaa  bafora  raading  again 
» . . “J . 9* 

.  ,  raturns  rd-ratid 

(Bag  (ZL  ascii  atB)  (N  1)) 

[ .  .  (or  (•  n  0)  (rd-alaap  n)) 

, .  .  ( rd-ratid)) 

, (dafun  ayputcbar ( chr  voptional  (n  0)),siaap  tiaa  bafora  raading  in  again 
(sand  *ridoo«  1  tyo  cbr) 
j  (or  ( >  o  0)  ( slaap  o  > ) 

< rd-ratid)) 


(dafua  rd-rasat( ) 

< ■ '  flush  all  tha  buffars  and  raaat  tha  port  so  tha  usar  can  rasat 
If  in  casa  iom  thlag  goaa  wrong. 

) 


.(dafun  aygatchar ( )  "J.p«) 


... (dafun  ayputchar ( ch ) 

, , . ,  -J .P" 

...  rtturoi  rd-ratid) 

(dafun  vd-ratid(  ) 

I  (lat  ((ratch  (aygatchar )  ) ) 

(cond  ((or  {•  rttcb  *UZERO*) 

{-  ratch  *ONULL* ) 

(•  ratch  «UACX«) 

I  (-  ratch  *UCOMj>-) 

|  (-  ratch  •  UPGNE  *  )  )  0) 

i  ((•  ratch  «UNTA*«)  (aag  1  "Nurbtr  not  found  " )  1) 

((■  ratch  •  UERRO* )  (mag  1  "InTalid  Couisd  ■* )  2) 

'  ((•  ratch  •  UN ACE* ) 

(msg  1  "Contod  not  la  valid  rang#  “ )  )) 

(C  (mag  1  "Returning  undafiand  coda  "  ratch)  5)))) 

(dafun  vd-s«odaua( x ) 

(do  ((ana  0  (ayputchar  (car  tapl))) 

1  ( t»pl  ( ZL : axplodan  x)  (cdr  tapl))) 

((or  (>  ana  0)  (null  tapl))  ana))) 

(dafaacro  »d-i«ro(  )  '(ayputchar  *UZERO«)) 

(dafaacro  vd-play ( ^optional  (nl  1)) 

'(■yputchar  (cond  ((>  , nl  0)  «UFPLA*) 

!  (t  *URPLA*)))) 

((dafaacro  vd- f ast ( (.optional  (nl  l)) 

'(■yputchar  (cond  ((>  , ai  0)  • UFFAS * ) 
j  (t  *  URFAS • ) ) ) ) 

'(dafaacro  vd- slov( ^optional  (nl  L)) 
l  '(ayputchar  (cond  <<>  , nl  0)  *UFSLO«) 
j  (t  • URSLO* ) )  )  ) 

I (dafaacro  vd-atep( ^optional  (nl  1)) 

!  '(ayputchar  (cond  ((>  . nl  0)  *UFSTE*) 

(t  • URSTE •  )  )  )  ) 

j(dafmacro  vd-scan( ^optional  (nl  1)) 
j  '(ayputchar  (cond  ((>  ,ni  0)  *UFSCA*) 

(t  -URSCA*)))) 

I (defnacro  vd-still() 

'(■yputchar  •USTXL*)) 

;  (dafaacro  vd-stop() 

'(■yputchar  •USTOPM) 

^dafaacro  vd-antar ( ^optional  (sltiaa  l)) 

'(■yputchar  «UCNTE*  , sltiaa)) 


(dafaacro  vd-ca( j 

■ ( ■yputchar  *UCE* ) ) 


(dafaacro  vd-aanu(  ) 

'(■yputchar  »UMENU*)) 


(dafaacro  vd-saarch( ) 

'(■yputchar  -USEAR*)) 


(dafaacro  vd-rapaat< ) 

'(■yputchar  «UREPE*)) 

(dafaacro  vd-sagaaot( ) 

'(■yputchar  -USEGN*)) 

(dafaacro  vd-chl ( ^optional  (nl  -1)) 

'(■yputchar  (cood  (<>  ,oi  0)  *0CH1N*) 
{ (-  , nl  0)  •DCH1F" ) 

( t  *ucii* ) ) ) ) 

(dafaacro  vd-chi { toptiooal  (nl  -1)) 

'(■yputchar  (cond  ((>  ,nl  0)  *UCH2N*) 
((-  , nl  0)  *UCH2  F* ) 

(  t  •0CB2M  )  )  ) 

(dafaacro  vd- lndax( ^optional  (  nl  -1)) 

'(■yputchar  (cond  ((>  , nl  0)  *UINDN*) 
((•  , ol  0)  • UIN0F* ) 

(t  ■ UINDE  *  )  )  )  ) 

(dafaacro  vd-duapin( } 

'(■yputchar  ’DDUMN*)) 

(dafaacro  vd-duapout( ) 

'{■yputchar  •UDUHT*)) 

j  (dafaacro  vd-d(  ) 

'(■yputchar  •UCL*)) 

| (dafaacro  vd-pgaj j 

'(■yputchar  *UPCM*)) 

(dafaacro  »d-run( ) 

'(■yputchar  ‘(Jltm*)) 

(dafaacro  »d-aod( ) 

'(■yputchar  *UEND*J) 

(dafaacro  rd-«antory< ) 

1  '(ayputchar  • UMEMO* ) ) 

!  (dafaacro  vd-aaaarcb< ) 

1  '(ayputchar  *UMSEA*)) 

(dafaacro  *d~afclp{) 

*  (ayputchar  *tJSKXP*)> 

(dafaacro  vd- lnt( ) 

'(ayputchar  *UI1IT«)) 

(dafaacro  Td-rariaw( ) 

'(■yputchar  *fflEVl*|) 

(dafaacro  rd-aoda( 4 optional  (nl  >1)) 

‘(ayputchar  (cond  ({<  ,  nl  0}  *0*cmE*  ) 
_  M*  ,al  0)  *PFRAM* ) 


(t  *  USEHO*  J) )  ) 


|(defaacro  Td-cootloue< ) 

I  '(ayputchar  -UCONT*)) 

i(detaacro  Td-aotor ( fcoptiooai  (  nl  l)) 

'(ayputchar  (cood  (<>  ,al  Oj  *UMOTN*j 
(t  • UMOTF* ) ) ) ) 

jfdefaacro  Td-aleep< ^optional  ( al  l ) ) 
i  '(cood  ((<  .nl  0)  (sleep  (ruus  .al))  0) 

(t  (sleep  ,al)  0)))  .  ll*p  slaap  function  ••*«** 

| (defun  »d-s#irch-{riat(nua) 

!  ( pro*  (tap) 

!  (if  (or  (<  ou«  0)  (>  nua  54000))  (return  4)) 

i  (if  (>  ( setf  tap  (ayputchar  *U5EAR*))  0)  (return  tap)} 

( if  ( >  ( setf  tap  (7d-sendnua  nua))  0)  (return  tap)) 
(return  (fd-tater  2)))) 


(defun  ▼d-se*rch-*egaent( nua ) 

(prog  (tap) 

(  if  (or  (<  aua  0)  (>  nua  63))  (return  4)) 

(if  (>  (setf  tap  (ayputchar  *USEAR«))  0)  (return  tap)) 
j  (if  (>  (setf  tap  (ayputchar  «UMODE*))  0)  (return  tap)) 

(if  (>  (setf  tap  (Td-sendnua  aua))  0)  (return  tap)) 

(return  (Td-enter  2)))) 

(defua  »d- search- fraae-repeat ( bnua  enua  ^optional  (ntaes  1)  (speed  0)) 
(pro*  (tap) 

(if  (<  bnua  0)  (setf  bnua  0)) 

(if  (>  boua  54000)  (setf  bnua  54000)) 

(if  (<  enua  0)  (setf  enua  0)) 

(if  (>  enua  54000)  (setf  enua  54000)) 

(if  (>  (setf  tap  <7d- search- frame  bnua))  0)  (return  tap)) 

(if  (<  ntaes  0)  (setf  otaes  0)) 

otaes  IS)  (setf  ntaes  15)) 

(setf  tap  (ayputchar  *UREPE*))  0)  (return  tap)) 

(setf  tap  (Td-sendnua  enua))  0)  (return  tap)) 

( ( <  speed  0 ) 

(If  (>  (setf  tap  (ayputchar  (If  (>  bnua  enua) 

•  U  R  S 10 •  *  UFSLO* ) ) )  0) 

( return  tap ) ) ) 

( ( >  speed  0 ) 

(if  (>  (setf  tap  (ayputchar  (if  (>  bnua  «dub) 

•  URFAS  *  *UFFAS  * ) )  )  0) 

( return  tap) ) ) ) 

(if  (>  (setf  tap  (ayputchar  • UENTE  *  )  )  0)  (return  tap)) 

(If  (>  (setf  tap  (Td-sendnua  otaes))  0)  (return  tap)) 

(return  (Td-enter  2)))) 

i (defun  7d-search-segaent-repeat( bnua  enua 

^optional  (ntaes  l)  (speed  0)) 

( prog  (tap) 

(if  (<  bnua  0)  (setf  bnua  0)) 

|  (if  <>  bnua  63)  (setf  boua  63)) 

j  (if  {<  enua  0)  (setf  enua  0)) 

(if  (>  enua  63)  (setf  enua  63)) 

! _  (if  (>  (setf  tap  ( Td- search- segaent  bnua))  0)  (return  tap)) 


(if 

( 

< 

(if 

( 

> 

(  if 

{ 

< 

(if 

( 

> 

(if 

< 

> 

(  if 

( 

< 

(if 

( 

> 

(  if 

( 

> 

(  if 

( 

> 

(cood 

(If  (<  otaes  0)  (setf  ntaes  0)) 

(If  (>  otaes  15)  (setf  ntaes  15)) 
(if  (>  (setf  tap  (ayputchar  *UREPE* 
(if  (>  (setf  tap  (Td-sendnua  enua)) 
(cond  ((<  speed  0) 

(if  (>  (setf  tap  (ayputchar 

( return  tap ) ) ) 

((>  speed  0) 

(if  (>  (setf  tap  (ayputchar 


I 


(return  tap)))) 

(if  (>  (setf  tap  (ayputchar  • UENTE*  j ] 
(if  (>  (setf  tap  (Td-sendnua  ntaes)) 
(return  (Td-enter  2)))) 


) )  0 )  ( return  tap) ) 
0)  ( return  tap) > 


(If  ( >  bnua  anua ) 
•URSLO*  *  U  F  S 10 • ) ) ) 


(if  ( >  bnua  anua ) 
•URFAS*  • UFFAS •  )  )  ) 


0 )  ( raturo  tap) ) 
0)  (raturo  tap)) 


(if  (< 


(  if 
(if 
(  if 
(if 
(  if 
(If 
(  if 


I  (defun  Td- search- f rase*- repeat  (foua  sous  ^optional  (ntaes  l)  (speed  0)) 
,  (pro*  (tap) 

(If  (<  fnua  0)  (setf  fnua  0)) 

(if  <>  fnua  63)  ( setf  foua  63)) 
laua  0)  (setf  soua  0}) 

(dub  54000)  ( satf  soua  63)) 

(setf  tap  ( Td- search- frame  fnua))  0)  (return  tap)) 
ntaes  0)  (setf  ntaes  0)) 
ntaes  15)  (setf  otaes  15)) 

(setf  tap  (ayputchar  *UR£PE*))  0)  (return  tap)) 

(setf  tap  (ayputchar  *UNODE*j)  0)  (return  tap)) 

(setf  tap  (Td-seodoua  sous) )  0}  (return  tap)) 

( cood  ( ( <  speed  0 ) 

(if  (>  (setf  tap  (ayputchar  -UFSLO* )>  0) 

( return  tap) ) ) 

( { >  speed  0 ) 

(if  (>  (setf  tap  (ayputchar  »UFFAS*))  0) 

(return  tap)))) 

(if  (>  (setf  tap  (ayputchar  *UENTC*))  0)  (return  tap)) 

(if  (>  (setf  tap  (Td-sendnua  ntaes))  oj  (return  tap)) 

(return  (Td-enter  2)))) 

(defun  Td-se*saae( snua  bnua  enua) 

(pro*  (tap) 

(cood  ((or  (<  soua  0)  (>  soua  63)) 

(as*  L  ■ Illegal  segment  number  "  sous) 

(as*  L  -  should  be  with  in  0  and  63  * ) 

( return  4 ) ) ) 
bnua  0)  (setf  bnua  0)) 

enua  0)  (setf  enua  0)) 

bnua  0)  (setf  boua  54000)) 

enua  0)  (setf  enua  54000)) 


(if  (< 

<  if 
(if 
(  If 


(  > 

(If  (>  bnua  enua)  (psetf  bnua  enua  enua  bnua)) 

(If  (>  ( setf  tap  (ayputchar  *USEGM*)}  >  0)  (return  tap)) 

(if  (>  ( satf  tap  ( Td- send nua  iausj )  >  0)  (return  tap)} 

(If  (>  (setf  tap  (ayputchar  • UENTE* ) )  >  0)  ( retura  tap)) 

(if  (>  (setf  tap  (Td-sendnua  bnua))  >  0)  (retura  tap)) 

(If  (>  (setf  tap  ( ayputchar  »UENTE* ) )  >  0)  ( ratun  tap)) 

(if  (>  (setf  tap  ( Td- send aua  enua))  >  0)  (return  tap)) 

(retura  (vd-enter  2)))) 

(defua  *d-help< ) 

(ass  (N  1)  •  ay*etchar") 


<a*g 

(N 

U 

ayputcbsr"  ) 

(■*g 

{N 

l) 

vd-ca* ) 

(•*9 

(N 

D 

▼d-chl" ) 

( ■*<? 

<N 

D 

▼d-chi-  ) 

< «*q 

(N 

i) 

Td-ci-  ) 

{■*9 

<N 

L) 

»d-clo*«“ ) 

(•*9 

(N 

L) 

Td-cootiau«* ) 

(»*9 

(N 

L) 

▼d-duapiQa ) 

(»*9 

(N 

D 

vd-duapou t“ > 

(*•9 

(N 

L  ) 

Td-«od“ ) 

(■*9 

(N 

L) 

rd-aotar" ) 

(■•9 

(« 

L) 

vd- c««t*i 

(■*9 

(N 

L ) 

▼d- lndax" ) 

<■*9 

<M 

l) 

▼d- 1  at* ) 

(»»q 

(N 

D 

vd-aaaory" ) 

(■*9 

(M 

L) 

Td-MDU"  ) 

(»*9 

(N 

L) 

vd-aoda" ) 

(■•9 

(N 

l) 

vd-aotor" > 

(■•9 

<N 

L) 

vd-a«a«rch“ ) 

(»*9 

(N 

L) 

vd-opana ) 

(■«9 

(N 

L) 

vd-pga‘ ) 

(»*9 

(N 

l  ) 

▼d-playa ) 

(»«9 

<N 

1) 

vd-rapa*ta ) 

(■•9 

(N 

L) 

»d-ra*at" 1 

(■*9 

(N 

L) 

vd-ratid" ) 

(■•9 

(N 

l) 

»d-rt»l#v ) 

(■•9 

(N 

D 

rd-ruo*  ) 

(»*9 

(N 

l> 

vd-scso" ) 

(■*9 

<N 

1) 

vd-sa*rcha  > 

(»*9 

(N 

U 

»d- saarch-f r«aaH ) 

(■•9 

(N 

L) 

vd-  saarcb-  (rM*> rapaat"  > 

<a«9 

(N 

L) 

vd- tatrch- f  rasag- rtpait  a 

(*•9 

<N 

L) 

fd-i**rcls-  sagaant"  ) 

(a*9 

(N 

1) 

▼d-sa*rch- sagaant-rapaat" ) 

(■»9 

(N 

l) 

vd- sagaaot" ) 

( **9 

<N 

l> 

vd- saqiaTt’ ) 

<a*9 

(N 

1) 

▼d- ttodDua" ) 

( a*9 

(N 

l) 

vd-sfclp" ) 

<asg 

(S 

1) 

vd-slaap" > 

( a»g 

( N 

1) 

vd- slow" ) 

(■•g 

(N 

1) 

vd- Stap" ) 

(■*9 

(N 

U 

▼d- still" ) 

<  asq 

(N 

I) 

vd- stop" ) 

(asg 

(N 

L) 

* 

vd-  zaro1* )  ) 

LA50  PRINTER 


-  Mode  ■  LISP,  syntax:  letalisp.  Package:  USER.  LovtrctM:  Yea ,  But:  LO 


-----  print. lisp  ----- 

.  This  package  allow*  the  ua*c  to  print  scrtto  duapt  to  the  1  a 5 0  prmtir 
coDDtcttd  to  SOU  serial  port  B.  Any  rectangular  portion  of  tba  screen 
Bay  be  duaped.  The  printer  is  not  the  fastest  in  the  world. . . 

(defun  *te*l-port-b( ) 

(dollat  (der  a t ; al 1-shared-der tee* ) 

(cood  ((String-equal  “SDU-SCRIM.-B- 

( send  dee  case ) ) 

(send  dee  allocate  t) 

(rplaca  (send  dee  lock)  nil) 

( return  dee ) ) )  )  ) 


(defun  get-nua  (bl  ^optional  <b2  IbO)  (b3  I bO )  (  b4  IbO)  (b5  IbO)  ( b6  IbO)) 
(♦  {*  1  bl)  (•  2  b2  )  (•  4  bl)  (•  3  b4  )  (•  L  6  b5 )  (•  32  b6)  S3)) 

(defun  llp50pr(arhd  wd  ht> 

(let'  ( ( nwd  (*  S  (celling  ht  6))) 

(nht  wd) 

(nwar-t  (aake-array  (list  nht  nwd) 

■type  art-lb  :  tnitial-ealue  IbO)) 

tch  nwdl  nhtl  nht2 

) 


direction  to ) 


escape 

P 


( copy-array-conteo t s  arhd  awar-t) 

( wi th-open- f  lie  ( IpSO  9du- serial- b :  " 

(send  Lp50  set-baud-rate  4800) 

(send  lp50  '  tyo  Io033) 

(send  lp50  -tyo  Iol20) 

(send  lp 50  tyo  lol61) 

(send  lp50  ' : tyo  <o0L4) 

( global : dotlaes  (1  (ceiling  nht  612)) 

( setf  nhtl  ( *  1  612)) 

( global : dot iaes  (j  (ceiling  nwd  6)) 

( setf  nwdl  ( •  5  6 ) ) 

for  each  row  of  <•  712  pixels 
(global  dotlaes  (k  (am  612  {-  wd  nhtl))) 

( setq  nht2  < ♦  nhtl  k ) 

tch  (get-nua  (aref  nwar-t  nwdl  nht2) 

(aref  nwar-t  (» 

(aref  nwar-t  (♦ 

(aref  nwar-t  ( ♦ 


fora  feed 
for  each  strip 


for  each  coluap  of  6pixels 


(aref  nwar-t  ( •* 


1  nwdl)  nht2) 

2  nwdl }  nbt2 ) 
nwdl)  nht2) 
nwdl)  nht2) 


<aref  awar-t  ( 5  owdl)  nht2))) 

(send  lp50  •  tyo  tch) 

(send  lp50  • : tyo  tch)),.  twice  because  of  the  aspect  ratio  1-2 
(send  lp5Q  'tyo  !o055)  ,,  next  line 

( aod  ( terop  (aod  nwdl  131)) 

(send  lp50  tyo  loOl*))) 

(send  ip 50  '  tyo  Io0l4))))) 


( coaaeot 

(defun  lllp50pr ( arhd  wd  ht) 

(let  ( ( htl  (•  6  (celling  ht  6))) 
nwar-t 

tch  nwdl  nhtl  nwd2 ) 


(cood  ((equal  ht  htl)  (setf  nwar-t  arhd)) 

(t  (setf  nwar-t  (aake-array  (list  wd  htl) 

( copy-array-cootents  arhd  nwar-t))) 

( with-open-f lie  (IpSO  " sdu-serial-b : "  direction  io) 
(send  IpSO  set-baud-rate  4800) 

(send  lp50  set-output-buf fer-size  1023) 

(send  IpSO  : set-f orce-output-p  nil) 


type  ' art- lb) ) 


( send  IpSO  • : tyo 
( send  lp50  ■ • tyo 
(  send  IpSO  •  :  tyo 
( send  IpSO  ' • tyo 

1  o03  3  ) 
f oi 20 ) 

•ol61) 

Io0l4 ) 

.  escape 
,  P 

*  q 

fora  feed 

( global : dotlaes 
( setf  nwdl  ( * 

( 1  ( ceiling  wd 
1  500)) 

500)  ) 

i  for 

each  strip 

( global : dotlaes  (j  (celling 
( setf  nhtl  (•  }  6)) 

for  each  row  of  <-  572, 

htl  6)) 

pixels 

81n 

,•  for 

each  coluap 

( global .dotlaes  (k  (ala  500  (-  wd 
( setq  nvd2  ( ♦  nwdl  k ) 

nwdl ) 

) ) 

tch 

(get-nua  (aref 

nwar-t 

nhtl 

nwd  2 ) 

(  aref 

nwar-t 

{  + 

1 

□  htl ) 

ovd2 ) 

(  aref 

nwar-t 

<  + 

2 

nhtl ) 

owd2  ) 

( aref 

ovar- t 

(  + 

3 

ohtl  ) 

nwd2  > 

( aref 

nwar-t 

<♦ 

4 

□  htl ) 

nwd  2  ) 

( send  IpSO 

(  aref 
: tyo  tch) 

owir-t 

( ♦ 

5 

nhtl ) 

nwd2) )  ) 

(send  IpSO  'tyo  tch)).,  twice  because 
(send  IpSO  'tyo  Io055) 

(and  ( zarop  (aod  nhtl  131)) 

( seod  IpSO  'tyo  Io014))) 

(send  IpSO  '  tyo  Io014))))) 


of  the  aspect  ratio  1:2 
next  Line 


fora  feed  (next  page) 


RAMTEK 


but  C ( 2 0  )  « 
i  f  (  (wm« 


length  4  OxFF.  buff(21|  •  OxOO, 

22  ♦  length)  4  l)  w»ue*»,  •  number  of  bytes  Cor  write  «/ 


bptr  *  4buff ( 22 |  . 

while<  length-- )  *bptr**  -  'textptr* 


if  ( vntei  raatet ,  buff,  vsize) 
return  (0), 


wjlza)  returo(-L), 


r  _wtab(  values ,  lo«d_table,  start,  avals,  select__table ) 
char  'values , 

Lot  load_table,  start,  avals,  select  table. 

I 

register  l,  ),  A. 

)  -  0. 

Lf (ovals)  {  •  Then  euat  load  before  selecting  «/ 

'  •  Load  Auxiliary  Meaory  couisd  --  Device  0  •• 

bufflO!  -  0x00. 
buf  f ( 1 J  -  0x03. 

•  Table  start  address  --  I6bit  start,  not  entry  start 


buff f  2 ! 
buf f ( 3 J 


( i  -  start 
(  (  l  >  >  S  1  * 


Vuaber  of  bytes  to  load  *- 


buf f ( 4 | 
buffi  31 


(  i 
( 1 


avals  •  4 ) 

>  3)  4  OxFF. 


2  )  - 

t load  table  •  2))  4  OxFF. 
4  tuts  nuaber  of  entries 
OxFF. 


for 

L»0.  i »' o v a  1  s .  l* 

*  )  t 

buf  f (  }••  ) 

•  *vi lues** . 

•  Blue  •/ 

buf  f( j- -  I 

“  'values**. 

•  Green  ’ 

buff l j » • l 

*  'values**. 

•  Red  •  / 

i 

buff (3**1 

•  • values** , 

•AndanyblinA  * 

*  -  ). 

•  Either 

;ero  or  (S  *  (ovals  •  4))  •» 

b  u  f  f  (  A  *  *  i  ■ 

0x00. 

Select  table 

.  , 

buf fit**]  - 

0x0  3  . 

bu  f  f ( A*  * !  - 

0. 

Table  auaber  • 

bufftk-*!  - 

( select_table 

•2)4  0x04, 

buf  f ( A** 1  - 

0. 

Just  selecting 

so  no  actual  writing  •/ 

Out  f  (  A  **  I  - 

0. 

if  (  wnt«(  rantek  ,  buff.  A) 

' •  A )  raturni -1 ) . 

return ( select  tabLe). 

) 

r_viaiqe ( laagedata. 

xatart.  yatart 

,  Duapts,  scan_ 

style,  operation) 

char  *taagedata. 

int  xstart.  yatart, 

nuapts.  acanstyle.  operation. 

regiater  i. 

) ,  rnuapts . 

1  •  0. 

buf  f ( 1** 1  • 

OxOT, 

/•  Flags 

(RP,  OF1 ,  OF2 ,  DF)  */ 

buf  f ( i*  * !  - 

OxOA. 

•  write 

Iaage  instruction  • / 

bu  f  f (  l  **  |  - 

0x80. 

'•  OF1  — 

Scan ,  ...  •/ 

buffi  1  *  *  1  • 

0x88  . 

.  COP 

,  Function  •/ 

buf ft  1**  1  • 

0x20. 

/•  OF2  -- 

Iaage  Mode ...  •/ 

buff(t**l  • 

0x00, 

'•  ■  Nothing  •/ 

buffi  1** 
buf ft  1** 

buffi  1** 
buf f [ 1** 

buffi  1** 
buf  f [ t** 
buffi i** 
buf f ( l •• 

buff  It** 
buffi t** 

buff [ l** 
buffi t** 


scan  style  4  0x07, 

0x007 


operation  4  0x0F. 
0x00, 


xstart  4  OxFF. 

( xstart  >>  3)  * 
ystart  4  Oxrr. 
(yatart  >>  8)  < 

0x0  L  , 

0x00, 


0x0  7  , 
0x03  . 


Scan  direction  •/ 

Function  •/ 

COP  at  first  •/ 

(■age  Mode  ■/ 


( rnuapts 
( rnuapts 


ounpts)  4  OxFF, 
>  3)  4  0x07, 


whilst rnuapts-- )  buffft**l  -  iaagedata(j* 
if  ( wrlte< raate* , buf f  ,  l )  *•  t)  return(-l), 

return  (  0 


1 


r_logo(x.  y) 

Lot  x,  y, 

t 

r  rect( x ,  y ,  x* 17  5 , 
r ^texti ( x*4l .  y*L0. 
r ”text2 ( x*  77 .  y*20. 
r ~text2 ( x*28 ,  y*  J 0  , 
r  “texti  (  x*  7"* ,  y*4  0  , 
r ~text2 ( x*  7 ,  y*  50 , 


y*  70 .  4  j , 

)  ,  4  ,  “NAVY  CENTER "  )  . 

3  .  4  .  '*  FOR  “  )  , 

),  4,  "APPLIED  RESEARCH**  )  . 

i,  4,  “IN"). 

I.  4.  "ARTIFICIAL  INTELLIGENCE"), 


11 sprtk . c 


Till*  set  of  functions  Is  complied,  then  loaded  Into  the  lisp 
environment  with  "cfasl" ,  with  appropriate  binding  of  LISP 
function  names  to  the  actual  C  routines. 

-ompiie  with: 

cc  -O  -c  lisprtk.c 


static  char  buffdSO), 
static  Ut  ramtek. 


r  open(  ) 

I  “ 

if((ramtefc  *  opeD("/da»<'rtk"  ,  2))  •:  0)  return  (-1). 
retur n( 0 ) , 

J 

r  closa( ) 

{  ~ 

closet r amtek ) , 
return ( 0 ) , 

) 


r_Llne(xO,  yO.  xl ,  yl,  color) 
int  *x0,  *y0.  *xl,  ’yl,  ’color, 

{ 

bufffO]  *  0x03,  buffdl  »  OxOE. 

bu  f  f [ 2 1  ■  0x02,  buf  f ( 3 |  •  0x80, 

bu f f { 4 ]  •  ’color  h  7.  buff(5)  -  0x00, 

buf f ( 6 ]  ■  «x0  b  OxFF ,  buf f [ 7 1  -  { *x0  >>  8)  b  0x01, 

buf  f { 8 ]  -  *  yO  b  OxFF,  buf  f ( 9 ]  -  (*y0  >>  8)  b  0x01. 

buf  f ( 10 ]  -  0x04.  buffdl]  •  0x00, 

buf f ( L 2 ]  •  ’xl  b  OxFF.  buf f { 13 1  -  ( ’xl  >>  8)  b  0x01, 

buff(l41  -  »yi  b  OxFF.  buffllSJ  *  (’yl  >>  8)  b  0x01, 

if (writet r aatet,  buff.  16)  •»  L6)  return  {*!). 
return  ( 0  )  , 


r_r*ct(x0,  yO.  xl,  yl.  color) 
int  »x0,  ’yO.  *xl.  *yl,  ’color. 

( 

buff(0)  -  0x02.  buff[l|  -  0x09, 
buff{2]  -  0X44.  bu  f  f [ 3 }  •  0X00. 
buf f ( 4  J  *  ’color  b  ?,  buffdl  * 
buffdl  •  *x0  b  OxFF,  buff[?|  - 
buf  f ( 8 )  -  ’V0  b  OxFF.  buf  f ( 9 1  - 
buff [10J  -  ’xl  b  OxFF,  buf f ( 11 ) 
buf  f  d2  |  -  *yl  b  OxFF.  buf  f  (  L3  I 


0x00. 

(•xO  >>  8)  b  0x01. 
{’yO  >>  8)  b  OxOL. 

-  (’Xl  >>  3)  b  0x0 1 . 

-  ( • y l  >  >  8 )  b  0x0  L , 


if  (wntet  ramtek,  buff,  L4)  14)  return  (-1), 

return  (0), 


r  eriset ) 

(~ 

bufffO)  -  0x0 2.  buf f ( 1 1  -  0x09. 
buf f  f  2 ]  -  0x44,  bu  f  f | 3 ]  -  0x00. 
buf  f [ 4 )  -  0x00.  buf  f [ 5 1  -  0x00. 
buffdl  •  0x00,  buffdl  -  0x00. 
buff ( 8 |  -  0x00.  buf  f [ 9 )  •  0x00, 
buffdOl  -  OxFr,  buff  (Ll|  -  0x01. 
buf  f ( 12 )  •  Oxrp.  bu f  f ( 1 3 ]  -  0x01, 

If (write ( ramtek ,  buff,  14)  '»  14)  return  (-1). 
return  ( 0 ) . 


r_reset{ ) 

1 

bufffO]  -  0x00.  buffd!  -  0x05. 

if (vritef ramtek .  buff,  2)  ••  2)  return  (-1), 
return  ( o ) . 

) 

r^textfxO,  yO,  color,  textptr) 

Int  ’xO,  *y0,  ’color, 
char  ’textptr, 

( 

reqister  int  wslze.  length, 
register  char  ’bptr. 

bufffOJ  -  OxOB,  buffdl  -  OxOC. 
buf  f  f  2 ]  -  0x46.  bu  f  f [ 3 |  •  0x80. 

buff[4)  -  ’color  b  7,  buffd]  *  0x00. 
buf  f ( 6 |  •  0x00,  buf  f ( 7 1  -  0x00. 
buff(8|  -  0x00,  bu  f  f ( 9 |  -  0x00. 
buf  f  (  LO  ]  •  0x00,  buffdll  -  0x00. 

buf  f  d  2 |  -  Oxrr,  buf f ( 13]  •  OxOL. 

bu  f  f  f  L  4  I  -  Oxrr.  bufffisj  -  0x01. 

bu  f  t ( 16 )  *  *  xO  b  OxFF,  bufffl71  -  f’xO  >>  9)  b  0x01, 

buffflS]  •  *y0  b  Oxrr,  buff(L9|  -  ( *y0  />  8)  b  OxOi, 

length  •  strlent textptr i . 

iftlength  0)  return(-l). 

iff  length  >  ?  B )  leoqth  -  1 8 .  •  maximum  sire  string  which  fit 

buf  t  f  20 )  •  length  b  OxFF.  buff{21]  -  0x00. 

ifttwslte  •  2  2  -  length)  b  1)  w»ue**  •’  number  of  byte*  for 
bptr  •  bbuf f | 2 2 ] , 

whllef length-- i  'bptr**  -  ’textptr** 

if  (*rrite(  ramtek ,  buff,  wslze)  (  wsizej  return(-l). 
return  ( 0) , 

) 


